aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Input.hs
diff options
context:
space:
mode:
authorpacien2020-05-02 04:11:24 +0200
committerpacien2020-05-02 04:11:24 +0200
commit8e3ac8fe44bebb38e1882ca7f06b8100078ad88d (patch)
treea748fa1e639cb3b5e1f24a8150e89dbb28c980cb /compiler/src/Input.hs
parent7042ffc06326fa8ffe70f5a59747709250166c16 (diff)
parent0e0b5b0ae44da7c1d67983dedd8f8d8d3516236f (diff)
downloadldgallery-8e3ac8fe44bebb38e1882ca7f06b8100078ad88d.tar.gz
Merge branch 'develop': release v1.0v1.0
Diffstat (limited to 'compiler/src/Input.hs')
-rw-r--r--compiler/src/Input.hs25
1 files changed, 22 insertions, 3 deletions
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index cb837e3..6ed7471 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -19,7 +19,7 @@
19module Input 19module Input
20 ( decodeYamlFile 20 ( decodeYamlFile
21 , Sidecar(..) 21 , Sidecar(..)
22 , InputTree(..), readInputTree 22 , InputTree(..), readInputTree, filterInputTree
23 ) where 23 ) where
24 24
25 25
@@ -58,6 +58,7 @@ data InputTree =
58 | InputDir 58 | InputDir
59 { path :: Path 59 { path :: Path
60 , modTime :: UTCTime 60 , modTime :: UTCTime
61 , sidecar :: Sidecar
61 , dirThumbnailPath :: Maybe Path 62 , dirThumbnailPath :: Maybe Path
62 , items :: [InputTree] } 63 , items :: [InputTree] }
63 deriving Show 64 deriving Show
@@ -79,6 +80,12 @@ emptySidecar = Sidecar
79sidecarExt :: String 80sidecarExt :: String
80sidecarExt = "yaml" 81sidecarExt = "yaml"
81 82
83dirPropFile :: String
84dirPropFile = "_directory"
85
86dirSidecar :: Path
87dirSidecar = Path [dirPropFile] <.> sidecarExt
88
82readSidecarFile :: FilePath -> IO Sidecar 89readSidecarFile :: FilePath -> IO Sidecar
83readSidecarFile filepath = 90readSidecarFile filepath =
84 doesFileExist filepath 91 doesFileExist filepath
@@ -107,7 +114,8 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
107 do 114 do
108 dirItems <- mapM mkInputNode items 115 dirItems <- mapM mkInputNode items
109 modTime <- getModificationTime $ localPath (anchor /> path) 116 modTime <- getModificationTime $ localPath (anchor /> path)
110 return $ InputDir path modTime (findThumbnail items) (catMaybes dirItems) 117 sidecar <- readSidecarFile $ localPath (anchor /> path </> dirSidecar)
118 return $ InputDir path modTime sidecar (findThumbnail items) (catMaybes dirItems)
111 119
112 isSidecar :: FSNode -> Bool 120 isSidecar :: FSNode -> Bool
113 isSidecar Dir{} = False 121 isSidecar Dir{} = False
@@ -120,7 +128,18 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
120 isThumbnail File{path} = 128 isThumbnail File{path} =
121 fileName path 129 fileName path
122 & fmap dropExtension 130 & fmap dropExtension
123 & (maybe False ("thumbnail" ==)) 131 & (maybe False (dirPropFile ==))
124 132
125 findThumbnail :: [FSNode] -> Maybe Path 133 findThumbnail :: [FSNode] -> Maybe Path
126 findThumbnail = (fmap Files.path) . (find isThumbnail) 134 findThumbnail = (fmap Files.path) . (find isThumbnail)
135
136-- | Filters an InputTree. The root is always returned.
137filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree
138filterInputTree cond = filterNode
139 where
140 filterNode :: InputTree -> InputTree
141 filterNode inputFile@InputFile{} = inputFile
142 filterNode inputDir@InputDir{items} =
143 filter cond items
144 & map filterNode
145 & \curatedItems -> inputDir { items = curatedItems } :: InputTree