aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r--compiler/src/Resource.hs65
1 files changed, 42 insertions, 23 deletions
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 60b783e..dc849cd 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -1,5 +1,3 @@
1{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
2
3-- ldgallery - A static generator which turns a collection of tagged 1-- ldgallery - A static generator which turns a collection of tagged
4-- pictures into a searchable web gallery. 2-- pictures into a searchable web gallery.
5-- 3--
@@ -18,9 +16,17 @@
18-- You should have received a copy of the GNU Affero General Public License 16-- You should have received a copy of the GNU Affero General Public License
19-- along with this program. If not, see <https://www.gnu.org/licenses/>. 17-- along with this program. If not, see <https://www.gnu.org/licenses/>.
20 18
19{-# LANGUAGE
20 DuplicateRecordFields
21 , DeriveGeneric
22 , DeriveAnyClass
23#-}
21 24
22module Resource 25module Resource
23 ( ResourceTree(..) 26 ( ResourceTree(..)
27 , DirProcessor
28 , ItemProcessor
29 , ThumbnailProcessor
24 , buildResourceTree 30 , buildResourceTree
25 , flattenResourceTree 31 , flattenResourceTree
26 , outputDiff 32 , outputDiff
@@ -29,8 +35,9 @@ module Resource
29 35
30import Data.Function ((&)) 36import Data.Function ((&))
31import Data.List ((\\)) 37import Data.List ((\\))
38import Data.Maybe (mapMaybe)
32import Files 39import Files
33import Input 40import Input (InputTree(..), Sidecar)
34 41
35 42
36-- | Tree representing the compiled gallery resources. 43-- | Tree representing the compiled gallery resources.
@@ -38,33 +45,46 @@ data ResourceTree =
38 ItemResource 45 ItemResource
39 { sidecar :: Sidecar 46 { sidecar :: Sidecar
40 , resPath :: Path 47 , resPath :: Path
41 , itemThumbnailPath :: Path } 48 , thumbnailPath :: Maybe Path }
42 | DirResource 49 | DirResource
43 { items :: [ResourceTree] 50 { items :: [ResourceTree]
44 , resPath :: Path 51 , resPath :: Path
45 , dirThumbnailPath :: Maybe Path } 52 , thumbnailPath :: Maybe Path }
46 deriving Show 53 deriving Show
47 54
48 55
49-- TODO: actually generate compilation strategies 56type DirProcessor = Path -> IO Path
50buildResourceTree :: InputTree -> ResourceTree 57type ItemProcessor = Path -> IO Path
51buildResourceTree = resNode 58type ThumbnailProcessor = Path -> IO (Maybe Path)
59
60-- TODO: parallelise this!
61buildResourceTree ::
62 DirProcessor -> ItemProcessor -> ThumbnailProcessor -> InputTree
63 -> IO ResourceTree
64buildResourceTree processDir processItem processThumbnail = resNode
52 where 65 where
53 resNode (InputFile path sidecar) = 66 resNode (InputFile path sidecar) =
54 ItemResource 67 do
55 { sidecar = sidecar 68 processedItem <- processItem path
56 , resPath = itemsDir /> path 69 processedThumbnail <- processThumbnail path
57 , itemThumbnailPath = thumbnailsDir /> path } 70 return ItemResource
71 { sidecar = sidecar
72 , resPath = processedItem
73 , thumbnailPath = processedThumbnail }
58 74
59 resNode (InputDir path thumbnailPath items) = 75 resNode (InputDir path thumbnailPath items) =
60 map resNode items 76 do
61 & \dirItems -> DirResource 77 processedDir <- processDir path
62 { items = dirItems 78 processedThumbnail <- maybeThumbnail thumbnailPath
63 , resPath = itemsDir /> path 79 dirItems <- mapM resNode items
64 , dirThumbnailPath = fmap ((/>) thumbnailsDir) thumbnailPath } 80 return DirResource
81 { items = dirItems
82 , resPath = processedDir
83 , thumbnailPath = processedThumbnail }
65 84
66 itemsDir = "items" 85 maybeThumbnail :: Maybe Path -> IO (Maybe Path)
67 thumbnailsDir = "thumbnails" 86 maybeThumbnail Nothing = return Nothing
87 maybeThumbnail (Just path) = processThumbnail path
68 88
69 89
70flattenResourceTree :: ResourceTree -> [ResourceTree] 90flattenResourceTree :: ResourceTree -> [ResourceTree]
@@ -72,12 +92,11 @@ flattenResourceTree item@ItemResource{} = [item]
72flattenResourceTree dir@(DirResource items _ _) = 92flattenResourceTree dir@(DirResource items _ _) =
73 dir:(concatMap flattenResourceTree items) 93 dir:(concatMap flattenResourceTree items)
74 94
75
76outputDiff :: ResourceTree -> FSNode -> [Path] 95outputDiff :: ResourceTree -> FSNode -> [Path]
77outputDiff resources ref = (fsPaths ref) \\ (resPaths resources) 96outputDiff resources ref = (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
78 where 97 where
79 resPaths :: ResourceTree -> [Path] 98 resPaths :: [ResourceTree] -> [Path]
80 resPaths = map resPath . flattenResourceTree 99 resPaths resList = (map resPath resList) ++ (mapMaybe thumbnailPath resList)
81 100
82 fsPaths :: FSNode -> [Path] 101 fsPaths :: FSNode -> [Path]
83 fsPaths = map nodePath . tail . flattenDir 102 fsPaths = map nodePath . tail . flattenDir