diff options
Diffstat (limited to 'compiler/src/Input.hs')
-rw-r--r-- | compiler/src/Input.hs | 25 |
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 @@ | |||
19 | module Input | 19 | module 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 | |||
79 | sidecarExt :: String | 80 | sidecarExt :: String |
80 | sidecarExt = "yaml" | 81 | sidecarExt = "yaml" |
81 | 82 | ||
83 | dirPropFile :: String | ||
84 | dirPropFile = "_directory" | ||
85 | |||
86 | dirSidecar :: Path | ||
87 | dirSidecar = Path [dirPropFile] <.> sidecarExt | ||
88 | |||
82 | readSidecarFile :: FilePath -> IO Sidecar | 89 | readSidecarFile :: FilePath -> IO Sidecar |
83 | readSidecarFile filepath = | 90 | readSidecarFile 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. | ||
137 | filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree | ||
138 | filterInputTree 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 | ||