compiler: do not require sidecar file

GitHub: closes #4

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 @@
 
 module Files
   ( FileName, LocalPath, WebPath, Path
-  , (</>), (</), (/>), localPath, webPath
+  , (</>), (</), (/>), (<.>), localPath, webPath
   , FSNode(..), AnchoredFSNode(..)
   , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
   , ensureParentDir, remove, isOutdated
@@ -62,6 +62,9 @@ path </ file = file:path
 (/>) :: FileName -> Path -> Path
 file /> path = path ++ [file]
 
+(<.>) :: Path -> String -> Path
+(filename:pathto) <.> ext = System.FilePath.addExtension filename ext : pathto
+
 localPath :: Path -> LocalPath
 localPath = System.FilePath.joinPath . reverse
 
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)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Function ((&))
 import Data.Maybe (mapMaybe, catMaybes)
+import Data.Bool (bool)
 import Data.List (find)
 import Data.Yaml (ParseException, decodeFileEither)
 import Data.Aeson (FromJSON)
 import System.FilePath (isExtensionOf, dropExtension)
+import System.Directory (doesFileExist)
 
 import Files
 
@@ -76,15 +78,23 @@ emptySidecar = Sidecar
   , description = Nothing
   , tags = Nothing }
 
+sidecarExt :: String
+sidecarExt = "yaml"
+
+readSidecarFile :: FilePath -> IO Sidecar
+readSidecarFile filepath =
+  doesFileExist filepath
+  >>= bool (return Nothing) (decodeYamlFile filepath)
+  >>= return . maybe emptySidecar id
+
 
 readInputTree :: AnchoredFSNode -> IO InputTree
 readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
   where
     mkInputNode :: FSNode -> IO (Maybe InputTree)
-    mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename =
-      (decodeYamlFile (localPath $ anchor /> path) :: IO (Maybe Sidecar))
-      >>= return . maybe emptySidecar id
-      >>= return . InputFile ((dropExtension filename):pathto)
+    mkInputNode (File path@(filename:_)) | not (sidecarExt `isExtensionOf` filename) =
+      readSidecarFile (localPath $ anchor /> path <.> sidecarExt)
+      >>= return . InputFile path
       >>= return . Just
     mkInputNode File{} = return Nothing
     mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just