diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/src/Files.hs | 5 | ||||
-rw-r--r-- | compiler/src/Input.hs | 18 |
2 files changed, 18 insertions, 5 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 079da61..d1363a1 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -23,7 +23,7 @@ | |||
23 | 23 | ||
24 | module Files | 24 | module Files |
25 | ( FileName, LocalPath, WebPath, Path | 25 | ( FileName, LocalPath, WebPath, Path |
26 | , (</>), (</), (/>), localPath, webPath | 26 | , (</>), (</), (/>), (<.>), localPath, webPath |
27 | , FSNode(..), AnchoredFSNode(..) | 27 | , FSNode(..), AnchoredFSNode(..) |
28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory | 28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory |
29 | , ensureParentDir, remove, isOutdated | 29 | , ensureParentDir, remove, isOutdated |
@@ -62,6 +62,9 @@ path </ file = file:path | |||
62 | (/>) :: FileName -> Path -> Path | 62 | (/>) :: FileName -> Path -> Path |
63 | file /> path = path ++ [file] | 63 | file /> path = path ++ [file] |
64 | 64 | ||
65 | (<.>) :: Path -> String -> Path | ||
66 | (filename:pathto) <.> ext = System.FilePath.addExtension filename ext : pathto | ||
67 | |||
65 | localPath :: Path -> LocalPath | 68 | localPath :: Path -> LocalPath |
66 | localPath = System.FilePath.joinPath . reverse | 69 | localPath = System.FilePath.joinPath . reverse |
67 | 70 | ||
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index c90db5c..597394e 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs | |||
@@ -34,10 +34,12 @@ import Control.Exception (Exception, throwIO) | |||
34 | import Control.Monad.IO.Class (MonadIO, liftIO) | 34 | import Control.Monad.IO.Class (MonadIO, liftIO) |
35 | import Data.Function ((&)) | 35 | import Data.Function ((&)) |
36 | import Data.Maybe (mapMaybe, catMaybes) | 36 | import Data.Maybe (mapMaybe, catMaybes) |
37 | import Data.Bool (bool) | ||
37 | import Data.List (find) | 38 | import Data.List (find) |
38 | import Data.Yaml (ParseException, decodeFileEither) | 39 | import Data.Yaml (ParseException, decodeFileEither) |
39 | import Data.Aeson (FromJSON) | 40 | import Data.Aeson (FromJSON) |
40 | import System.FilePath (isExtensionOf, dropExtension) | 41 | import System.FilePath (isExtensionOf, dropExtension) |
42 | import System.Directory (doesFileExist) | ||
41 | 43 | ||
42 | import Files | 44 | import Files |
43 | 45 | ||
@@ -76,15 +78,23 @@ emptySidecar = Sidecar | |||
76 | , description = Nothing | 78 | , description = Nothing |
77 | , tags = Nothing } | 79 | , tags = Nothing } |
78 | 80 | ||
81 | sidecarExt :: String | ||
82 | sidecarExt = "yaml" | ||
83 | |||
84 | readSidecarFile :: FilePath -> IO Sidecar | ||
85 | readSidecarFile filepath = | ||
86 | doesFileExist filepath | ||
87 | >>= bool (return Nothing) (decodeYamlFile filepath) | ||
88 | >>= return . maybe emptySidecar id | ||
89 | |||
79 | 90 | ||
80 | readInputTree :: AnchoredFSNode -> IO InputTree | 91 | readInputTree :: AnchoredFSNode -> IO InputTree |
81 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | 92 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root |
82 | where | 93 | where |
83 | mkInputNode :: FSNode -> IO (Maybe InputTree) | 94 | mkInputNode :: FSNode -> IO (Maybe InputTree) |
84 | mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename = | 95 | mkInputNode (File path@(filename:_)) | not (sidecarExt `isExtensionOf` filename) = |
85 | (decodeYamlFile (localPath $ anchor /> path) :: IO (Maybe Sidecar)) | 96 | readSidecarFile (localPath $ anchor /> path <.> sidecarExt) |
86 | >>= return . maybe emptySidecar id | 97 | >>= return . InputFile path |
87 | >>= return . InputFile ((dropExtension filename):pathto) | ||
88 | >>= return . Just | 98 | >>= return . Just |
89 | mkInputNode File{} = return Nothing | 99 | mkInputNode File{} = return Nothing |
90 | mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just | 100 | mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just |