gdritter repos bricoleur / 484fbb8
Switch to logging helper functions Getty Ritter 5 years ago
3 changed file(s) with 42 addition(s) and 54 deletion(s). Collapse all Expand all
+26
-42
src/Collage/Commands/Splice.hs less more
11 {-# LANGUAGE OverloadedStrings #-}
22
3 module Collage.Commands.Splice (runSplice, findFragments) where
3 module Collage.Commands.Splice(runSplice) where
44
55 import Control.Monad (foldM)
66 import qualified Data.Map as M
77 import qualified Data.Text as T
88 import qualified Data.Text.Lazy as TL
99 import qualified Data.Text.Lazy.IO as TL
10 import qualified System.Exit as Sys
1110 import System.FilePath ((</>))
1211 import qualified System.FilePath as Sys
1312
1413 import Collage.Config
1514 import Collage.Opts
15 import Collage.Utils
1616
1717 findFragmentIdentifiers :: TL.Text -> [T.Text]
1818 findFragmentIdentifiers t
2121 , not (TL.null f) = TL.toStrict f : findFragmentIdentifiers rs'
2222 | otherwise = []
2323
24 newtype Fragment = Fragment [T.Text] deriving (Eq, Show)
25
2426 toIdent :: T.Text -> TL.Text
2527 toIdent = TL.fromStrict . T.cons '«' . flip T.snoc '»'
2628
27 findFragments :: FilePath -> T.Text -> [Source] -> Either String (IO TL.Text)
29 findFragments :: FilePath -> T.Text -> [Source] -> Either TL.Text (IO TL.Text)
2830 findFragments root s sources = case (T.splitOn "/" s) of
29 [] -> error "(should not happen)"
31 [] -> throw "Invalid empty fragment name!"
3032 (x:rs) -> case [ src
3133 | src@Source { sourceName = n } <- sources
3234 , n == x
3335 ] of
3436 [src] -> go src rs (sourceExpose src)
35 [] -> Left ("Unable to find source named " ++ T.unpack x)
36 _ -> Left ("Ambiguous source name: " ++ T.unpack x)
37 [] -> throw ("Unable to find source named " % stext) x
38 _ -> throw ("Ambiguous source name: " % stext) x
3739 where
38 go :: Source -> [T.Text] -> Expose -> Either String (IO TL.Text)
40
3941 go q [] (ExposeFile path) =
4042 return (TL.readFile (root </> sourceDir q </> path))
4143 go _ [] ExposeSections{} =
42 Left $ concat [ "Splice identifier «"
43 , T.unpack s
44 , "» matches a file with sections, but "
45 , "does not specify a section!"
46 ]
44 throw ("Splice identifier «" % stext %
45 "» matches a file with sections") s
4746 go _ [] NamedMap{} =
48 Left $ concat [ "Splice identifier «"
49 , T.unpack s
50 , "» matches a map, but does not specify "
51 , "a key!"
52 ]
47 throw ("Splice identifier «" % stext %
48 "» matches a map, but does not specify a key!") s
5349
5450 go q [section] (ExposeSections path) =
5551 return (readSection (root </> sourceDir q </> path) section)
5652
5753 go _ (_:_) (ExposeSections path) =
58 Left $ concat [ "Splice identifier «"
59 , T.unpack s
60 , "» indexes too far into the path "
61 , path
62 , "!"
63 ]
54 throw ("Splice identifier «" % stext %
55 "» indexes too far into the path " % string % "!")
56 s path
6457
6558 go _ (_:_) (ExposeFile path) =
66 Left $ concat [ "Splice identifier «"
67 , T.unpack s
68 , "» indexes too far into the file "
69 , path
70 , "!"
71 ]
59 throw ("Splice identifier «" % stext %
60 "» indexes too far into the file " % string % "!")
61 s path
7262
7363 go q (k:rs) (NamedMap m)
7464 | Just e <- M.lookup k m = go q rs e
75 | otherwise = Left $ concat
76 [ "Splice identifier «"
77 , T.unpack s
78 , "» references a key "
79 , T.unpack k
80 , " which cannot be found."
81 ]
65 | otherwise = throw
66 ("Splice identifier «" % stext %
67 "» references a key " % stext %
68 " which cannot be found.") s k
8269
8370 doReplacements :: FilePath -> [Source] -> TL.Text -> IO TL.Text
8471 doReplacements root e original =
8673 where
8774 doReplace file frag = do
8875 new <- case findFragments root frag e of
89 Left err -> Sys.die err
76 Left err -> cError err
9077 Right x -> x
9178 return (TL.replace (toIdent frag) new file)
9279
9481 readSection path f = do
9582 contents <- TL.readFile path
9683 case TL.breakOn (toIdent f) contents of
97 (_, "") -> Sys.die $ unwords [ "Unable to find section"
98 , show f
99 , "in file"
100 , path
101 ]
84 (_, "") -> cError (format ("Unable to find section " % shown %
85 " in file " % string) f path)
10286 (_, rs) ->
10387 let (_, skipLine) = TL.breakOn "\n" rs
10488 (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)
+15
-12
src/Collage/Commands/Test.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
13 module Collage.Commands.Test (runTest) where
24
35 import Control.Monad (forM_)
4 import qualified Data.Text as T
6 import System.FilePath ((</>))
7 import qualified System.FilePath as Sys
58 import qualified System.Process as Sys
69
710 import Collage.Opts
811 import Collage.Config
9
10 dbg :: [String] -> IO ()
11 dbg = putStrLn . unwords
12 import Collage.Utils
1213
1314 runTest :: Config -> Options -> IO ()
14 runTest conf _ = do
15 dbg ["testing", confDocument conf ]
15 runTest conf opts = do
16 let root = Sys.takeDirectory (optFile opts)
17 cDebug (format ("running tests for " % shown) (confDocument conf))
1618 forM_ (confSources conf) $ \ samp -> do
17 dbg ["-", "building source", T.unpack (sourceName samp) ]
18 runCommand samp
19 cDebug (format ("- running test for " % stext) (sourceName samp))
20 runCommand root samp
1921
20 runCommand :: Source -> IO ()
21 runCommand src = do
22 runCommand :: FilePath -> Source -> IO ()
23 runCommand root src = do
2224 forM_ (sourceCommands src) $ \ln -> do
23 dbg [" ", "- running", show ln]
24 let process = (Sys.shell ln) { Sys.cwd = Just ("example/" ++ sourceDir src) }
25 let dir = root </> sourceDir src
26 cDebug (format (" - $ " % shown % " in " % string) ln dir)
27 let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
2528 (_, _, _, h) <- Sys.createProcess process
2629 Sys.waitForProcess h
+1
-0
src/Collage.hs less more
1313 import qualified Collage.Commands.Splice as Cmd
1414 import qualified Collage.Commands.Test as Cmd
1515
16 -- | Run the main @collage@ function with the provided options.
1617 main :: Opt.Options -> IO ()
1718 main opts = do
1819 configMb <- Conf.getConfig (Opt.optFile opts)