Switch to logging helper functions

src/Collage.hs

@@ -13,6 +13,7 @@ import qualified Collage.Opts as Opt
 import qualified Collage.Commands.Splice as Cmd
 import qualified Collage.Commands.Test as Cmd
 
+-- | Run the main @collage@ function with the provided options.
 main :: Opt.Options -> IO ()
 main opts = do
   configMb <- Conf.getConfig (Opt.optFile opts)

src/Collage/Commands/Splice.hs

@@ -1,18 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Collage.Commands.Splice (runSplice, findFragments) where
+module Collage.Commands.Splice(runSplice) where
 
 import           Control.Monad (foldM)
 import qualified Data.Map as M
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO as TL
-import qualified System.Exit as Sys
 import           System.FilePath ((</>))
 import qualified System.FilePath as Sys
 
 import Collage.Config
 import Collage.Opts
+import Collage.Utils
 
 findFragmentIdentifiers :: TL.Text -> [T.Text]
 findFragmentIdentifiers t
@@ -21,64 +21,51 @@ findFragmentIdentifiers t
   , not (TL.null f) = TL.toStrict f : findFragmentIdentifiers rs'
   | otherwise = []
 
+newtype Fragment = Fragment [T.Text] deriving (Eq, Show)
+
 toIdent :: T.Text -> TL.Text
 toIdent = TL.fromStrict . T.cons '«' . flip T.snoc '»'
 
-findFragments :: FilePath -> T.Text -> [Source] -> Either String (IO TL.Text)
+findFragments :: FilePath -> T.Text -> [Source] -> Either TL.Text (IO TL.Text)
 findFragments root s sources = case (T.splitOn "/" s) of
-    [] -> error "(should not happen)"
+    [] -> throw "Invalid empty fragment name!"
     (x:rs) -> case [ src
                    | src@Source { sourceName = n } <- sources
                    , n == x
                    ] of
                [src] -> go src rs (sourceExpose src)
-               []  -> Left ("Unable to find source named " ++ T.unpack x)
+               []  -> throw ("Unable to find source named " % stext) x
-               _   -> Left ("Ambiguous source name: " ++ T.unpack x)
+               _   -> throw ("Ambiguous source name: " % stext) x
   where
-    go :: Source -> [T.Text] -> Expose -> Either String (IO TL.Text)
+
     go q [] (ExposeFile path) =
       return (TL.readFile (root </> sourceDir q </> path))
     go _ [] ExposeSections{} =
-      Left $ concat [ "Splice identifier «"
+      throw ("Splice identifier «" % stext %
-                    , T.unpack s
+             "» matches a file with sections") s
-                    , "» matches a file with sections, but "
-                    , "does not specify a section!"
-                    ]
     go _ [] NamedMap{} =
-      Left $ concat [ "Splice identifier «"
+      throw ("Splice identifier «" % stext %
-                    , T.unpack s
+             "» matches a map, but does not specify a key!") s
-                    , "» matches a map, but does not specify "
-                    , "a key!"
-                    ]
 
     go q [section] (ExposeSections path) =
       return (readSection (root </> sourceDir q </> path) section)
 
     go _ (_:_) (ExposeSections path) =
-      Left $ concat [ "Splice identifier «"
+      throw ("Splice identifier «" % stext %
-                    , T.unpack s
+             "» indexes too far into the path " % string % "!")
-                    , "» indexes too far into the path "
+        s path
-                    , path
-                    , "!"
-                    ]
 
     go _ (_:_) (ExposeFile path) =
-      Left $ concat [ "Splice identifier «"
+      throw ("Splice identifier «" % stext %
-                    , T.unpack s
+             "» indexes too far into the file " % string % "!")
-                    , "» indexes too far into the file "
+        s path
-                    , path
-                    , "!"
-                    ]
 
     go q (k:rs) (NamedMap m)
       | Just e <- M.lookup k m = go q rs e
-      | otherwise = Left $ concat
+      | otherwise = throw
-                    [ "Splice identifier «"
+          ("Splice identifier «" % stext %
-                    , T.unpack s
+           "» references a key " % stext %
-                    , "» references a key "
+           " which cannot be found.") s k
-                    , T.unpack k
-                    , " which cannot be found."
-                    ]
 
 doReplacements :: FilePath -> [Source] -> TL.Text -> IO TL.Text
 doReplacements root e original =
@@ -86,7 +73,7 @@ doReplacements root e original =
   where
     doReplace file frag = do
       new <- case findFragments root frag e of
-        Left err -> Sys.die err
+        Left err -> cError err
         Right x  -> x
       return (TL.replace (toIdent frag) new file)
 
@@ -94,11 +81,8 @@ readSection :: FilePath -> T.Text -> IO TL.Text
 readSection path f = do
   contents <- TL.readFile path
   case TL.breakOn (toIdent f) contents of
-    (_, "") -> Sys.die $ unwords [ "Unable to find section"
+    (_, "") -> cError (format ("Unable to find section " % shown %
-                                 , show f
+                               " in file " % string) f path)
-                                 , "in file"
-                                 , path
-                                 ]
     (_, rs) ->
       let (_, skipLine) = TL.breakOn "\n" rs
           (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)

src/Collage/Commands/Test.hs

@@ -1,26 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Collage.Commands.Test (runTest) where
 
 import           Control.Monad (forM_)
-import qualified Data.Text as T
+import           System.FilePath ((</>))
+import qualified System.FilePath as Sys
 import qualified System.Process as Sys
 
 import Collage.Opts
 import Collage.Config
-
+import Collage.Utils
-dbg :: [String] -> IO ()
-dbg = putStrLn . unwords
 
 runTest :: Config -> Options -> IO ()
-runTest conf _ = do
+runTest conf opts = do
-  dbg ["testing", confDocument conf ]
+  let root = Sys.takeDirectory (optFile opts)
+  cDebug (format ("running tests for " % shown) (confDocument conf))
   forM_ (confSources conf) $ \ samp -> do
-    dbg ["-", "building source", T.unpack (sourceName samp) ]
+    cDebug (format ("- running test for " % stext) (sourceName samp))
-    runCommand samp
+    runCommand root samp
 
-runCommand :: Source -> IO ()
+runCommand :: FilePath -> Source -> IO ()
-runCommand src = do
+runCommand root src = do
   forM_ (sourceCommands src) $ \ln -> do
-    dbg [" ", "- running", show ln]
+    let dir = root </> sourceDir src
-    let process = (Sys.shell ln) { Sys.cwd = Just ("example/" ++ sourceDir src) }
+    cDebug (format ("  - $ " % shown % " in " % string) ln dir)
+    let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
     (_, _, _, h) <- Sys.createProcess process
     Sys.waitForProcess h