gdritter repos bricoleur / c2ce5ad
Rename Collage to Bricoleur Getty Ritter 6 years ago
16 changed file(s) with 441 addition(s) and 441 deletion(s). Collapse all Expand all
1 module Main where
2
3 import qualified Bricoleur
4
5 main :: IO ()
6 main = Bricoleur.getOpts >>= Bricoleur.main
1 cabal-version: 2.2
2 name: bricoleur
3 version: 0.1.0.0
4 synopsis: A tool for assembling documents out of working, testable code
5 description:
6 Bricoleur is a tool for writing documents that include snippets of code
7 in such a way that the code can be build and examined independently
8 of the source document.
9 license: BSD-3-Clause
10 author: Getty Ritter <gettylefou@gmail.com>
11 maintainer: Getty Ritter <gettylefou@gmail.com>
12 copyright: @2018 Getty Ritter
13 category: Text
14 build-type: Simple
15
16
17 library
18 exposed-modules: Bricoleur
19 , Bricoleur.Config
20 , Bricoleur.Opts
21 , Bricoleur.Commands.Test
22 , Bricoleur.Commands.Splice
23 , Bricoleur.Utils
24 build-depends: base >=4.7 && <5
25 , adnot
26 , bytestring
27 , containers
28 , directory
29 , filepath
30 , formatting
31 , optparse-applicative
32 , process
33 , text
34 , unix
35 , vector
36 hs-source-dirs: src
37 ghc-options: -Wall
38 default-language: Haskell2010
39
40 executable bricoleur
41 hs-source-dirs: bricoleur
42 main-is: Main.hs
43 default-language: Haskell2010
44 ghc-options: -Wall
45 build-depends: base >=4.7 && <5
46 , bricoleur
+0
-6
collage/Main.hs less more
1 module Main where
2
3 import qualified Collage
4
5 main :: IO ()
6 main = Collage.getOpts >>= Collage.main
+0
-46
collage.cabal less more
1 cabal-version: 2.2
2 name: collage
3 version: 0.1.0.0
4 synopsis: A tool for assembling documents out of working, testable code
5 description:
6 Collage is a tool for writing documents that include snippets of code
7 in such a way that the code can be build and examined independently
8 of the source document.
9 license: BSD-3-Clause
10 author: Getty Ritter <gettylefou@gmail.com>
11 maintainer: Getty Ritter <gettylefou@gmail.com>
12 copyright: @2018 Getty Ritter
13 category: Text
14 build-type: Simple
15
16
17 library
18 exposed-modules: Collage
19 , Collage.Config
20 , Collage.Opts
21 , Collage.Commands.Test
22 , Collage.Commands.Splice
23 , Collage.Utils
24 build-depends: base >=4.7 && <5
25 , adnot
26 , bytestring
27 , containers
28 , directory
29 , filepath
30 , formatting
31 , optparse-applicative
32 , process
33 , text
34 , unix
35 , vector
36 hs-source-dirs: src
37 ghc-options: -Wall
38 default-language: Haskell2010
39
40 executable collage
41 hs-source-dirs: collage
42 main-is: Main.hs
43 default-language: Haskell2010
44 ghc-options: -Wall
45 build-depends: base >=4.7 && <5
46 , collage
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Bricoleur.Commands.Splice(runSplice) where
4
5 import Control.Monad (foldM)
6 import qualified Data.Map as M
7 import qualified Data.Text as T
8 import qualified Data.Text.Lazy as TL
9 import qualified Data.Text.Lazy.IO as TL
10 import System.FilePath ((</>))
11 import qualified System.FilePath as Sys
12
13 import Bricoleur.Config
14 import Bricoleur.Opts
15 import Bricoleur.Utils
16
17 findFragmentIdentifiers :: TL.Text -> [T.Text]
18 findFragmentIdentifiers t
19 | (_, rs) <- TL.break (== '«') t
20 , (f, rs') <- TL.break (== '»') (TL.drop 1 rs)
21 , not (TL.null f) = TL.toStrict f : findFragmentIdentifiers rs'
22 | otherwise = []
23
24 newtype Fragment = Fragment [T.Text] deriving (Eq, Show)
25
26 toIdent :: T.Text -> TL.Text
27 toIdent = TL.fromStrict . T.cons '«' . flip T.snoc '»'
28
29 findFragments :: FilePath -> T.Text -> [Source] -> Either TL.Text (IO TL.Text)
30 findFragments root s sources = case (T.splitOn "/" s) of
31 [] -> throw "Invalid empty fragment name!"
32 (x:rs) -> case [ src
33 | src@Source { sourceName = n } <- sources
34 , n == x
35 ] of
36 [src] -> go src rs (sourceExpose src)
37 [] -> throw ("Unable to find source named " % stext) x
38 _ -> throw ("Ambiguous source name: " % stext) x
39 where
40
41 go q [] (ExposeFile path) =
42 return (cOpenFile "file source" (root </> sourceDir q </> path))
43 go _ [] ExposeSections{} =
44 throw ("Splice identifier «" % stext %
45 "» matches a file with sections") s
46 go _ [] NamedMap{} =
47 throw ("Splice identifier «" % stext %
48 "» matches a map, but does not specify a key!") s
49
50 go q [section] (ExposeSections path) =
51 return (readSection (root </> sourceDir q </> path) section)
52
53 go _ (_:_) (ExposeSections path) =
54 throw ("Splice identifier «" % stext %
55 "» indexes too far into the path " % string % "!")
56 s path
57
58 go _ (_:_) (ExposeFile path) =
59 throw ("Splice identifier «" % stext %
60 "» indexes too far into the file " % string % "!")
61 s path
62
63 go q (k:rs) (NamedMap m)
64 | Just e <- M.lookup k m = go q rs e
65 | otherwise = throw
66 ("Splice identifier «" % stext %
67 "» references a key " % stext %
68 " which cannot be found.") s k
69
70 doReplacements :: FilePath -> [Source] -> TL.Text -> IO TL.Text
71 doReplacements root e original =
72 foldM doReplace original (findFragmentIdentifiers original)
73 where
74 doReplace file frag = do
75 new <- case findFragments root frag e of
76 Left err -> cError ("Fragment error: " % text) err
77 Right x -> x
78 return (TL.replace (toIdent frag) new file)
79
80 readSection :: FilePath -> T.Text -> IO TL.Text
81 readSection path f = do
82 contents <- cOpenFile "section source" path
83 case TL.breakOn (toIdent f) contents of
84 (_, "") -> cError ("Unable to find section " % shown %
85 " in file " % string) f path
86 (_, rs) ->
87 let (_, skipLine) = TL.breakOn "\n" rs
88 (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)
89 (skipLine', _) = TL.breakOnEnd "\n" section
90 in return (TL.init skipLine')
91
92 runSplice :: Config -> Options -> IO ()
93 runSplice conf opts = do
94 let root = Sys.takeDirectory (optFile opts)
95 f <- cOpenFile "document" (root </> confDocument conf)
96 rs <- doReplacements root (confSources conf) f
97 TL.putStrLn rs
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Bricoleur.Commands.Test (runTest) where
4
5 import Control.Monad (forM_)
6 import System.FilePath ((</>))
7 import qualified System.FilePath as Sys
8 import qualified System.Process as Sys
9
10 import Bricoleur.Opts
11 import Bricoleur.Config
12 import Bricoleur.Utils
13
14 runTest :: Config -> Options -> IO ()
15 runTest conf opts = do
16 let root = Sys.takeDirectory (optFile opts)
17 cDebug ("running tests for " % shown) (confDocument conf)
18 forM_ (confSources conf) $ \ samp -> do
19 cDebug ("- running test for " % stext) (sourceName samp)
20 runCommand root samp
21
22 runCommand :: FilePath -> Source -> IO ()
23 runCommand root src = do
24 forM_ (sourceCommands src) $ \ln -> do
25 let dir = root </> sourceDir src
26 cDebug (" - $ " % shown % " in " % string) ln dir
27 let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
28 (_, _, _, h) <- Sys.createProcess process
29 Sys.waitForProcess h
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Bricoleur.Config
4 ( Config(..)
5 , Source(..)
6 , Expose(..)
7 , getConfig
8 , example
9 ) where
10
11 import Control.Applicative ((<|>))
12 import qualified Data.Adnot as A
13 import qualified Data.ByteString as B
14 import qualified Data.Map.Strict as M
15 import qualified Data.Text as T
16 import qualified Data.Vector as V
17
18 data Config = Config
19 { confDocument :: FilePath
20 , confSources :: [Source]
21 } deriving (Eq, Show)
22
23 instance A.FromAdnot Config where
24 parseAdnot = A.withSumNamed "config file" "document" go
25 where
26 go payload
27 | Just file <- payload V.!? 0
28 = Config <$> A.parseAdnot file
29 <*> mapM A.parseAdnot (V.toList (V.tail payload))
30 | otherwise = Left "expected source file in config"
31
32
33 data Source = Source
34 { sourceName :: T.Text
35 , sourceDir :: FilePath
36 , sourceCommands :: [String]
37 , sourceExpose :: Expose
38 } deriving (Eq, Show)
39
40 instance A.FromAdnot Source where
41 parseAdnot = A.withProduct "source" $ \p -> do
42 name <- p A..: "name"
43 dir <- p A..: "dir"
44 cmds <- p A..: "cmd"
45 expose <- p A..: "expose"
46 return (Source name dir cmds expose)
47
48
49 data Expose
50 = ExposeFile FilePath
51 | ExposeSections FilePath
52 | NamedMap (M.Map T.Text Expose)
53 deriving (Eq, Show)
54
55 instance A.FromAdnot Expose where
56 parseAdnot v = file v <|> sections v <|> namedMap v
57 where
58 file = A.withSumNamed "exposed fragments" "file" $ \ ps ->
59 case V.toList ps of
60 [] -> Left "Expected name for file"
61 [f] -> ExposeFile <$> A.parseAdnot f
62 _ -> Left "Too many arguments to file"
63
64 sections = A.withSumNamed "exposed fragments" "sections" $ \ ps ->
65 case V.toList ps of
66 [] -> Left "Expected name for sections"
67 [f] -> ExposeSections <$> A.parseAdnot f
68 _ -> Left "Too many arguments to sections"
69
70 namedMap = A.withProduct "exposed fragments" $ \ p ->
71 NamedMap <$> mapM A.parseAdnot p
72
73 parseConfig :: B.ByteString -> Either String Config
74 parseConfig = A.decode
75
76 getConfig :: FilePath -> IO (Either String Config)
77 getConfig loc = do
78 conf <- B.readFile loc
79 return (parseConfig conf)
80
81 example :: Config
82 example = Config
83 { confDocument = "main.md"
84 , confSources =
85 [ Source
86 { sourceName = "rust-sample"
87 , sourceDir = "s1"
88 , sourceCommands = ["cargo clean", "cargo build"]
89 , sourceExpose = ExposeFile "src/main.rs"
90 }
91 , Source
92 { sourceName = "haskell-sample"
93 , sourceDir = "s2"
94 , sourceCommands = ["cabal new-build"]
95 , sourceExpose = ExposeSections "Main.hs"
96 }
97 ]
98 }
1 module Bricoleur.Opts
2 ( Command(..)
3 , Options(..)
4 , getOpts
5 ) where
6
7 import Control.Applicative ((<|>))
8 import qualified Options.Applicative as Opt
9 import qualified System.Directory as Sys
10 import qualified System.FilePath as Sys
11
12 data Command
13 = Test
14 | Splice
15 deriving (Eq, Show)
16
17 data Options = Options
18 { optFile :: FilePath
19 , optVerbose :: Bool
20 , optCommand :: Command
21 } deriving (Eq, Show)
22
23 desc :: String
24 desc = "FINISH ME"
25
26 opts :: Opt.ParserInfo Options
27 opts = Opt.info (p Opt.<**> Opt.helper)
28 (Opt.progDesc desc <>
29 Opt.fullDesc <>
30 Opt.header "arglbargl")
31 where
32 p = Options <$> (path <|> pure "")
33 <*> verbose
34 <*> Opt.subparser (test <> splice)
35
36 path = Opt.strOption
37 (Opt.short 'f' <>
38 Opt.long "file" <>
39 Opt.metavar "PATH" <>
40 Opt.help "The path to the project file")
41
42 verbose = Opt.switch
43 (Opt.short 'v' <>
44 Opt.long "verbose" <>
45 Opt.help "Show debug messages")
46
47 test = Opt.command "test" $ Opt.info
48 (pure Test Opt.<**> Opt.helper)
49 (Opt.progDesc "test the provided sources")
50
51 splice = Opt.command "splice" $ Opt.info
52 (pure Splice Opt.<**> Opt.helper)
53 (Opt.progDesc "splice sources into a final draft")
54
55 getOpts :: IO Options
56 getOpts = do
57 cwd <- Sys.getCurrentDirectory
58 options <- Opt.execParser opts
59 return $ if null (optFile options)
60 then options { optFile = cwd Sys.</> "collage" }
61 else options
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Bricoleur.Utils
4 ( cOutput
5 , cDebug
6 , cWarn
7 , cError
8
9 , cOpenFile
10
11 , throw
12
13 , F.format
14 , (F.%)
15 , F.stext
16 , F.text
17 , F.string
18 , F.shown
19 ) where
20
21 import qualified Formatting as F
22 import qualified Data.Text.Lazy as TL
23 import qualified Data.Text.Lazy.Builder as TL
24 import qualified Data.Text.Lazy.IO as TL
25 import qualified System.Directory as Sys
26 import qualified System.Exit as Sys
27 import qualified System.IO as Sys
28 import qualified System.Posix.IO as Posix
29 import qualified System.Posix.Terminal as Posix
30
31 import Prelude (FilePath, IO, Either(Left), ($))
32
33 throw :: F.Format (Either TL.Text r) a -> a
34 throw f =
35 F.runFormat f (\ b -> Left (TL.toLazyText b))
36
37 stderr :: TL.Text -> IO ()
38 stderr = TL.hPutStr Sys.stderr
39
40 -- | Write output to stdout
41 cOutput :: TL.Text -> IO ()
42 cOutput = TL.putStrLn
43
44 -- | Write a debug message to stderr.
45 cDebug :: F.Format (IO ()) a -> a
46 cDebug msg = F.runFormat msg $ \ b ->
47 TL.hPutStrLn Sys.stderr (TL.toLazyText b)
48
49 -- | Write a warning message to stderr. If we are connected to a TTY,
50 -- then this will write in an orange color.
51 cWarn :: F.Format (IO ()) a -> a
52 cWarn msg = F.runFormat msg $ \b -> do
53 isTTY <- Posix.queryTerminal Posix.stdOutput
54 if isTTY
55 then do stderr "\x1b[93m"
56 stderr (TL.toLazyText b)
57 stderr "\x1b[39m\n"
58 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
59
60 -- | Write an error message to stderr and exit. If we are connected to
61 -- a TTY, this message will be in red.
62 cError :: F.Format (IO r) a -> a
63 cError msg = F.runFormat msg $ \b -> do
64 isTTY <- Posix.queryTerminal Posix.stdOutput
65 if isTTY
66 then do stderr "\x1b[91m"
67 stderr (TL.toLazyText b)
68 stderr "\x1b[39m\n"
69 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
70 Sys.exitFailure
71
72
73 cOpenFile :: TL.Text -> FilePath -> IO TL.Text
74 cOpenFile purpose path = do
75 exists <- Sys.doesFileExist path
76 if exists
77 then TL.readFile path
78 else cError ("Unable to open " F.% F.text F.%
79 " file at " F.% F.string) purpose path
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Bricoleur
4 ( main
5 , Opt.getOpts
6 ) where
7
8 import qualified System.Exit as Sys
9
10 import qualified Bricoleur.Config as Conf
11 import qualified Bricoleur.Opts as Opt
12
13 import qualified Bricoleur.Commands.Splice as Cmd
14 import qualified Bricoleur.Commands.Test as Cmd
15
16 -- | Run the main @collage@ function with the provided options.
17 main :: Opt.Options -> IO ()
18 main opts = do
19 configMb <- Conf.getConfig (Opt.optFile opts)
20 config <- case configMb of
21 Left err -> Sys.die err
22 Right x -> return x
23 case Opt.optCommand opts of
24 Opt.Test -> Cmd.runTest config opts
25 Opt.Splice -> Cmd.runSplice config opts
+0
-97
src/Collage/Commands/Splice.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Collage.Commands.Splice(runSplice) where
4
5 import Control.Monad (foldM)
6 import qualified Data.Map as M
7 import qualified Data.Text as T
8 import qualified Data.Text.Lazy as TL
9 import qualified Data.Text.Lazy.IO as TL
10 import System.FilePath ((</>))
11 import qualified System.FilePath as Sys
12
13 import Collage.Config
14 import Collage.Opts
15 import Collage.Utils
16
17 findFragmentIdentifiers :: TL.Text -> [T.Text]
18 findFragmentIdentifiers t
19 | (_, rs) <- TL.break (== '«') t
20 , (f, rs') <- TL.break (== '»') (TL.drop 1 rs)
21 , not (TL.null f) = TL.toStrict f : findFragmentIdentifiers rs'
22 | otherwise = []
23
24 newtype Fragment = Fragment [T.Text] deriving (Eq, Show)
25
26 toIdent :: T.Text -> TL.Text
27 toIdent = TL.fromStrict . T.cons '«' . flip T.snoc '»'
28
29 findFragments :: FilePath -> T.Text -> [Source] -> Either TL.Text (IO TL.Text)
30 findFragments root s sources = case (T.splitOn "/" s) of
31 [] -> throw "Invalid empty fragment name!"
32 (x:rs) -> case [ src
33 | src@Source { sourceName = n } <- sources
34 , n == x
35 ] of
36 [src] -> go src rs (sourceExpose src)
37 [] -> throw ("Unable to find source named " % stext) x
38 _ -> throw ("Ambiguous source name: " % stext) x
39 where
40
41 go q [] (ExposeFile path) =
42 return (cOpenFile "file source" (root </> sourceDir q </> path))
43 go _ [] ExposeSections{} =
44 throw ("Splice identifier «" % stext %
45 "» matches a file with sections") s
46 go _ [] NamedMap{} =
47 throw ("Splice identifier «" % stext %
48 "» matches a map, but does not specify a key!") s
49
50 go q [section] (ExposeSections path) =
51 return (readSection (root </> sourceDir q </> path) section)
52
53 go _ (_:_) (ExposeSections path) =
54 throw ("Splice identifier «" % stext %
55 "» indexes too far into the path " % string % "!")
56 s path
57
58 go _ (_:_) (ExposeFile path) =
59 throw ("Splice identifier «" % stext %
60 "» indexes too far into the file " % string % "!")
61 s path
62
63 go q (k:rs) (NamedMap m)
64 | Just e <- M.lookup k m = go q rs e
65 | otherwise = throw
66 ("Splice identifier «" % stext %
67 "» references a key " % stext %
68 " which cannot be found.") s k
69
70 doReplacements :: FilePath -> [Source] -> TL.Text -> IO TL.Text
71 doReplacements root e original =
72 foldM doReplace original (findFragmentIdentifiers original)
73 where
74 doReplace file frag = do
75 new <- case findFragments root frag e of
76 Left err -> cError ("Fragment error: " % text) err
77 Right x -> x
78 return (TL.replace (toIdent frag) new file)
79
80 readSection :: FilePath -> T.Text -> IO TL.Text
81 readSection path f = do
82 contents <- cOpenFile "section source" path
83 case TL.breakOn (toIdent f) contents of
84 (_, "") -> cError ("Unable to find section " % shown %
85 " in file " % string) f path
86 (_, rs) ->
87 let (_, skipLine) = TL.breakOn "\n" rs
88 (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)
89 (skipLine', _) = TL.breakOnEnd "\n" section
90 in return (TL.init skipLine')
91
92 runSplice :: Config -> Options -> IO ()
93 runSplice conf opts = do
94 let root = Sys.takeDirectory (optFile opts)
95 f <- cOpenFile "document" (root </> confDocument conf)
96 rs <- doReplacements root (confSources conf) f
97 TL.putStrLn rs
+0
-29
src/Collage/Commands/Test.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Collage.Commands.Test (runTest) where
4
5 import Control.Monad (forM_)
6 import System.FilePath ((</>))
7 import qualified System.FilePath as Sys
8 import qualified System.Process as Sys
9
10 import Collage.Opts
11 import Collage.Config
12 import Collage.Utils
13
14 runTest :: Config -> Options -> IO ()
15 runTest conf opts = do
16 let root = Sys.takeDirectory (optFile opts)
17 cDebug ("running tests for " % shown) (confDocument conf)
18 forM_ (confSources conf) $ \ samp -> do
19 cDebug ("- running test for " % stext) (sourceName samp)
20 runCommand root samp
21
22 runCommand :: FilePath -> Source -> IO ()
23 runCommand root src = do
24 forM_ (sourceCommands src) $ \ln -> do
25 let dir = root </> sourceDir src
26 cDebug (" - $ " % shown % " in " % string) ln dir
27 let process = (Sys.shell ln) { Sys.cwd = Just (root </> sourceDir src) }
28 (_, _, _, h) <- Sys.createProcess process
29 Sys.waitForProcess h
+0
-98
src/Collage/Config.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Collage.Config
4 ( Config(..)
5 , Source(..)
6 , Expose(..)
7 , getConfig
8 , example
9 ) where
10
11 import Control.Applicative ((<|>))
12 import qualified Data.Adnot as A
13 import qualified Data.ByteString as B
14 import qualified Data.Map.Strict as M
15 import qualified Data.Text as T
16 import qualified Data.Vector as V
17
18 data Config = Config
19 { confDocument :: FilePath
20 , confSources :: [Source]
21 } deriving (Eq, Show)
22
23 instance A.FromAdnot Config where
24 parseAdnot = A.withSumNamed "config file" "document" go
25 where
26 go payload
27 | Just file <- payload V.!? 0
28 = Config <$> A.parseAdnot file
29 <*> mapM A.parseAdnot (V.toList (V.tail payload))
30 | otherwise = Left "expected source file in config"
31
32
33 data Source = Source
34 { sourceName :: T.Text
35 , sourceDir :: FilePath
36 , sourceCommands :: [String]
37 , sourceExpose :: Expose
38 } deriving (Eq, Show)
39
40 instance A.FromAdnot Source where
41 parseAdnot = A.withProduct "source" $ \p -> do
42 name <- p A..: "name"
43 dir <- p A..: "dir"
44 cmds <- p A..: "cmd"
45 expose <- p A..: "expose"
46 return (Source name dir cmds expose)
47
48
49 data Expose
50 = ExposeFile FilePath
51 | ExposeSections FilePath
52 | NamedMap (M.Map T.Text Expose)
53 deriving (Eq, Show)
54
55 instance A.FromAdnot Expose where
56 parseAdnot v = file v <|> sections v <|> namedMap v
57 where
58 file = A.withSumNamed "exposed fragments" "file" $ \ ps ->
59 case V.toList ps of
60 [] -> Left "Expected name for file"
61 [f] -> ExposeFile <$> A.parseAdnot f
62 _ -> Left "Too many arguments to file"
63
64 sections = A.withSumNamed "exposed fragments" "sections" $ \ ps ->
65 case V.toList ps of
66 [] -> Left "Expected name for sections"
67 [f] -> ExposeSections <$> A.parseAdnot f
68 _ -> Left "Too many arguments to sections"
69
70 namedMap = A.withProduct "exposed fragments" $ \ p ->
71 NamedMap <$> mapM A.parseAdnot p
72
73 parseConfig :: B.ByteString -> Either String Config
74 parseConfig = A.decode
75
76 getConfig :: FilePath -> IO (Either String Config)
77 getConfig loc = do
78 conf <- B.readFile loc
79 return (parseConfig conf)
80
81 example :: Config
82 example = Config
83 { confDocument = "main.md"
84 , confSources =
85 [ Source
86 { sourceName = "rust-sample"
87 , sourceDir = "s1"
88 , sourceCommands = ["cargo clean", "cargo build"]
89 , sourceExpose = ExposeFile "src/main.rs"
90 }
91 , Source
92 { sourceName = "haskell-sample"
93 , sourceDir = "s2"
94 , sourceCommands = ["cabal new-build"]
95 , sourceExpose = ExposeSections "Main.hs"
96 }
97 ]
98 }
+0
-61
src/Collage/Opts.hs less more
1 module Collage.Opts
2 ( Command(..)
3 , Options(..)
4 , getOpts
5 ) where
6
7 import Control.Applicative ((<|>))
8 import qualified Options.Applicative as Opt
9 import qualified System.Directory as Sys
10 import qualified System.FilePath as Sys
11
12 data Command
13 = Test
14 | Splice
15 deriving (Eq, Show)
16
17 data Options = Options
18 { optFile :: FilePath
19 , optVerbose :: Bool
20 , optCommand :: Command
21 } deriving (Eq, Show)
22
23 desc :: String
24 desc = "FINISH ME"
25
26 opts :: Opt.ParserInfo Options
27 opts = Opt.info (p Opt.<**> Opt.helper)
28 (Opt.progDesc desc <>
29 Opt.fullDesc <>
30 Opt.header "arglbargl")
31 where
32 p = Options <$> (path <|> pure "")
33 <*> verbose
34 <*> Opt.subparser (test <> splice)
35
36 path = Opt.strOption
37 (Opt.short 'f' <>
38 Opt.long "file" <>
39 Opt.metavar "PATH" <>
40 Opt.help "The path to the project file")
41
42 verbose = Opt.switch
43 (Opt.short 'v' <>
44 Opt.long "verbose" <>
45 Opt.help "Show debug messages")
46
47 test = Opt.command "test" $ Opt.info
48 (pure Test Opt.<**> Opt.helper)
49 (Opt.progDesc "test the provided sources")
50
51 splice = Opt.command "splice" $ Opt.info
52 (pure Splice Opt.<**> Opt.helper)
53 (Opt.progDesc "splice sources into a final draft")
54
55 getOpts :: IO Options
56 getOpts = do
57 cwd <- Sys.getCurrentDirectory
58 options <- Opt.execParser opts
59 return $ if null (optFile options)
60 then options { optFile = cwd Sys.</> "collage" }
61 else options
+0
-79
src/Collage/Utils.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Collage.Utils
4 ( cOutput
5 , cDebug
6 , cWarn
7 , cError
8
9 , cOpenFile
10
11 , throw
12
13 , F.format
14 , (F.%)
15 , F.stext
16 , F.text
17 , F.string
18 , F.shown
19 ) where
20
21 import qualified Formatting as F
22 import qualified Data.Text.Lazy as TL
23 import qualified Data.Text.Lazy.Builder as TL
24 import qualified Data.Text.Lazy.IO as TL
25 import qualified System.Directory as Sys
26 import qualified System.Exit as Sys
27 import qualified System.IO as Sys
28 import qualified System.Posix.IO as Posix
29 import qualified System.Posix.Terminal as Posix
30
31 import Prelude (FilePath, IO, Either(Left), ($))
32
33 throw :: F.Format (Either TL.Text r) a -> a
34 throw f =
35 F.runFormat f (\ b -> Left (TL.toLazyText b))
36
37 stderr :: TL.Text -> IO ()
38 stderr = TL.hPutStr Sys.stderr
39
40 -- | Write output to stdout
41 cOutput :: TL.Text -> IO ()
42 cOutput = TL.putStrLn
43
44 -- | Write a debug message to stderr.
45 cDebug :: F.Format (IO ()) a -> a
46 cDebug msg = F.runFormat msg $ \ b ->
47 TL.hPutStrLn Sys.stderr (TL.toLazyText b)
48
49 -- | Write a warning message to stderr. If we are connected to a TTY,
50 -- then this will write in an orange color.
51 cWarn :: F.Format (IO ()) a -> a
52 cWarn msg = F.runFormat msg $ \b -> do
53 isTTY <- Posix.queryTerminal Posix.stdOutput
54 if isTTY
55 then do stderr "\x1b[93m"
56 stderr (TL.toLazyText b)
57 stderr "\x1b[39m\n"
58 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
59
60 -- | Write an error message to stderr and exit. If we are connected to
61 -- a TTY, this message will be in red.
62 cError :: F.Format (IO r) a -> a
63 cError msg = F.runFormat msg $ \b -> do
64 isTTY <- Posix.queryTerminal Posix.stdOutput
65 if isTTY
66 then do stderr "\x1b[91m"
67 stderr (TL.toLazyText b)
68 stderr "\x1b[39m\n"
69 else TL.hPutStrLn Sys.stderr (TL.toLazyText b)
70 Sys.exitFailure
71
72
73 cOpenFile :: TL.Text -> FilePath -> IO TL.Text
74 cOpenFile purpose path = do
75 exists <- Sys.doesFileExist path
76 if exists
77 then TL.readFile path
78 else cError ("Unable to open " F.% F.text F.%
79 " file at " F.% F.string) purpose path
+0
-25
src/Collage.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Collage
4 ( main
5 , Opt.getOpts
6 ) where
7
8 import qualified System.Exit as Sys
9
10 import qualified Collage.Config as Conf
11 import qualified Collage.Opts as Opt
12
13 import qualified Collage.Commands.Splice as Cmd
14 import qualified Collage.Commands.Test as Cmd
15
16 -- | Run the main @collage@ function with the provided options.
17 main :: Opt.Options -> IO ()
18 main opts = do
19 configMb <- Conf.getConfig (Opt.optFile opts)
20 config <- case configMb of
21 Left err -> Sys.die err
22 Right x -> return x
23 case Opt.optCommand opts of
24 Opt.Test -> Cmd.runTest config opts
25 Opt.Splice -> Cmd.runSplice config opts