diff options
Diffstat (limited to 'compiler/src/Input.hs')
-rw-r--r-- | compiler/src/Input.hs | 26 |
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 | ||
25 | module Input | 26 | module Input |
@@ -92,7 +93,7 @@ readInputTree :: AnchoredFSNode -> IO InputTree | |||
92 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | 93 | readInputTree (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) | ||