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.hs13
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)
27import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) 27import Control.Exception (Exception, AssertionFailed(..), throw, throwIO)
28import Control.Monad.IO.Class (MonadIO, liftIO) 28import Control.Monad.IO.Class (MonadIO, liftIO)
29import Data.Function ((&)) 29import Data.Function ((&))
30import Data.Functor ((<&>))
30import Data.Maybe (catMaybes) 31import Data.Maybe (catMaybes)
31import Data.Bool (bool) 32import Data.Bool (bool)
32import Data.List (find) 33import Data.List (find)
@@ -90,7 +91,7 @@ readSidecarFile :: FilePath -> IO Sidecar
90readSidecarFile filepath = 91readSidecarFile 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
96readInputTree :: AnchoredFSNode -> IO InputTree 97readInputTree :: 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.
137filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree 138filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree