diff options
Diffstat (limited to 'compiler/src/Input.hs')
-rw-r--r-- | compiler/src/Input.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 6ed7471..1316cdd 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs | |||
@@ -27,6 +27,7 @@ import GHC.Generics (Generic) | |||
27 | import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) | 27 | import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) |
28 | import Control.Monad.IO.Class (MonadIO, liftIO) | 28 | import Control.Monad.IO.Class (MonadIO, liftIO) |
29 | import Data.Function ((&)) | 29 | import Data.Function ((&)) |
30 | import Data.Functor ((<&>)) | ||
30 | import Data.Maybe (catMaybes) | 31 | import Data.Maybe (catMaybes) |
31 | import Data.Bool (bool) | 32 | import Data.Bool (bool) |
32 | import Data.List (find) | 33 | import Data.List (find) |
@@ -90,7 +91,7 @@ readSidecarFile :: FilePath -> IO Sidecar | |||
90 | readSidecarFile filepath = | 91 | readSidecarFile filepath = |
91 | doesFileExist filepath | 92 | doesFileExist filepath |
92 | >>= bool (return Nothing) (decodeYamlFile filepath) | 93 | >>= bool (return Nothing) (decodeYamlFile filepath) |
93 | >>= return . maybe emptySidecar id | 94 | <&> maybe emptySidecar id |
94 | 95 | ||
95 | 96 | ||
96 | readInputTree :: AnchoredFSNode -> IO InputTree | 97 | readInputTree :: AnchoredFSNode -> IO InputTree |
@@ -100,13 +101,13 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | |||
100 | where | 101 | where |
101 | mkInputNode :: FSNode -> IO (Maybe InputTree) | 102 | mkInputNode :: FSNode -> IO (Maybe InputTree) |
102 | mkInputNode file@File{path} | 103 | mkInputNode file@File{path} |
103 | | (not $ isSidecar file) && (not $ isThumbnail file) = | 104 | | not (isSidecar file) && not (isThumbnail file) = |
104 | do | 105 | do |
105 | sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt) | 106 | sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt) |
106 | modTime <- getModificationTime $ localPath (anchor /> path) | 107 | modTime <- getModificationTime $ localPath (anchor /> path) |
107 | return $ Just $ InputFile path modTime sidecar | 108 | return $ Just $ InputFile path modTime sidecar |
108 | mkInputNode File{} = return Nothing | 109 | mkInputNode File{} = return Nothing |
109 | mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just | 110 | mkInputNode dir@Dir{} = Just <$> mkDirNode dir |
110 | 111 | ||
111 | mkDirNode :: FSNode -> IO InputTree | 112 | mkDirNode :: FSNode -> IO InputTree |
112 | mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" | 113 | mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" |
@@ -121,17 +122,17 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | |||
121 | isSidecar Dir{} = False | 122 | isSidecar Dir{} = False |
122 | isSidecar File{path} = | 123 | isSidecar File{path} = |
123 | fileName path | 124 | fileName path |
124 | & (maybe False $ isExtensionOf sidecarExt) | 125 | & maybe False (isExtensionOf sidecarExt) |
125 | 126 | ||
126 | isThumbnail :: FSNode -> Bool | 127 | isThumbnail :: FSNode -> Bool |
127 | isThumbnail Dir{} = False | 128 | isThumbnail Dir{} = False |
128 | isThumbnail File{path} = | 129 | isThumbnail File{path} = |
129 | fileName path | 130 | fileName path |
130 | & fmap dropExtension | 131 | & fmap dropExtension |
131 | & (maybe False (dirPropFile ==)) | 132 | & maybe False (dirPropFile ==) |
132 | 133 | ||
133 | findThumbnail :: [FSNode] -> Maybe Path | 134 | findThumbnail :: [FSNode] -> Maybe Path |
134 | findThumbnail = (fmap Files.path) . (find isThumbnail) | 135 | findThumbnail = fmap Files.path . find isThumbnail |
135 | 136 | ||
136 | -- | Filters an InputTree. The root is always returned. | 137 | -- | Filters an InputTree. The root is always returned. |
137 | filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree | 138 | filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree |