aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Input.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Input.hs')
-rw-r--r--compiler/src/Input.hs26
1 files changed, 18 insertions, 8 deletions
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 2e11ebe..7e1b169 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -1,7 +1,7 @@
1-- ldgallery - A static generator which turns a collection of tagged 1-- ldgallery - A static generator which turns a collection of tagged
2-- pictures into a searchable web gallery. 2-- pictures into a searchable web gallery.
3-- 3--
4-- Copyright (C) 2019 Pacien TRAN-GIRARD 4-- Copyright (C) 2019-2020 Pacien TRAN-GIRARD
5-- 5--
6-- This program is free software: you can redistribute it and/or modify 6-- This program is free software: you can redistribute it and/or modify
7-- it under the terms of the GNU Affero General Public License as 7-- it under the terms of the GNU Affero General Public License as
@@ -20,6 +20,7 @@
20 DuplicateRecordFields 20 DuplicateRecordFields
21 , DeriveGeneric 21 , DeriveGeneric
22 , DeriveAnyClass 22 , DeriveAnyClass
23 , NamedFieldPuns
23#-} 24#-}
24 25
25module Input 26module Input
@@ -92,7 +93,7 @@ readInputTree :: AnchoredFSNode -> IO InputTree
92readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root 93readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
93 where 94 where
94 mkInputNode :: FSNode -> IO (Maybe InputTree) 95 mkInputNode :: FSNode -> IO (Maybe InputTree)
95 mkInputNode (File path) | not (sidecarExt `isExtensionOf` (fileName path)) = 96 mkInputNode file@File{path} | not $ isSidecar file =
96 readSidecarFile (localPath $ anchor /> path <.> sidecarExt) 97 readSidecarFile (localPath $ anchor /> path <.> sidecarExt)
97 >>= return . InputFile path 98 >>= return . InputFile path
98 >>= return . Just 99 >>= return . Just
@@ -104,10 +105,19 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
104 mapM mkInputNode items 105 mapM mkInputNode items
105 >>= return . catMaybes 106 >>= return . catMaybes
106 >>= return . InputDir path (findThumbnail items) 107 >>= return . InputDir path (findThumbnail items)
107 where
108 findThumbnail :: [FSNode] -> Maybe Path
109 findThumbnail = (fmap nodePath) . (find matchThumbnail)
110 108
111 matchThumbnail :: FSNode -> Bool 109 isSidecar :: FSNode -> Bool
112 matchThumbnail Dir{} = False 110 isSidecar Dir{} = False
113 matchThumbnail (File path) = (dropExtension $ fileName path) == "thumbnail" 111 isSidecar File{path} =
112 fileName path
113 & (maybe False $ isExtensionOf sidecarExt)
114
115 isThumbnail :: FSNode -> Bool
116 isThumbnail Dir{} = False
117 isThumbnail File{path} =
118 fileName path
119 & fmap dropExtension
120 & (maybe False ("thumbnail" ==))
121
122 findThumbnail :: [FSNode] -> Maybe Path
123 findThumbnail = (fmap Files.path) . (find isThumbnail)