Commit 7045b4a39d844c6520229625812d4381db0b9be2 - collage

+20

-0

.gitignore less more

	1	dist
	2	dist-*
	3	*~
	4	cabal-dev
	5	*.o
	6	*.hi
	7	*.chi
	8	*.chs.h
	9	*.dyn_o
	10	*.dyn_hi
	11	.hpc
	12	.hsenv
	13	.cabal-sandbox/
	14	cabal.sandbox.config
	15	*.prof
	16	*.aux
	17	*.hp
	18	*.eventlog
	19	cabal.project.local
	20	.ghc.environment.*

+6

-0

collage/Main.hs less more

	1	module Main where
	2
	3	import qualified Collage
	4
	5	main :: IO ()
	6	main = Collage.getOpts >>= Collage.main

+42

-0

collage.cabal less more

	1	cabal-version: 2.2
	2	name: collage
	3	version: 0.1.0.0
	4	-- synopsis:
	5	-- description:
	6	license: BSD-3-Clause
	7	author: Getty Ritter <gettylefou@gmail.com>
	8	maintainer: Getty Ritter <gettylefou@gmail.com>
	9	copyright: @2018 Getty Ritter
	10	-- category:
	11	build-type: Simple
	12
	13
	14	library
	15	hs-source-dirs: src
	16	ghc-options: -Wall
	17	build-depends: base >=4.7 && <5
	18	, adnot
	19	, bytestring
	20	, containers
	21	, directory
	22	, filepath
	23	, optparse-applicative
	24	, process
	25	, text
	26	, vector
	27	default-language: Haskell2010
	28	default-extensions: ScopedTypeVariables
	29	exposed-modules: Collage
	30	, Collage.Config
	31	, Collage.Opts
	32	, Collage.Commands.Test
	33	, Collage.Commands.Splice
	34
	35	executable collage
	36	hs-source-dirs: collage
	37	main-is: Main.hs
	38	default-language: Haskell2010
	39	default-extensions: ScopedTypeVariables
	40	ghc-options: -Wall
	41	build-depends: base >=4.7 && <5
	42	, collage

+7

-0

src/Collage/Commands/Splice.hs less more

	1	module Collage.Commands.Splice (runSplice) where
	2
	3	import Collage.Config
	4	import Collage.Opts
	5
	6	runSplice :: Config -> Options -> IO ()
	7	runSplice _ _ = putStrLn "Unimplemented!"

+26

-0

src/Collage/Commands/Test.hs less more

	1	module Collage.Commands.Test (runTest) where
	2
	3	import Control.Monad (forM_)
	4	import qualified Data.Text as T
	5	import qualified System.Process as Sys
	6
	7	import Collage.Opts
	8	import Collage.Config
	9
	10	dbg :: [String] -> IO ()
	11	dbg = putStrLn . unwords
	12
	13	runTest :: Config -> Options -> IO ()
	14	runTest conf _ = do
	15	dbg ["testing", T.unpack (confDocument conf) ]
	16	forM_ (confSources conf) $ \ samp -> do
	17	dbg ["-", "building source", T.unpack (sourceName samp) ]
	18	runCommand samp
	19
	20	runCommand :: Source -> IO ()
	21	runCommand src = do
	22	forM_ (sourceCommands src) $ \ln -> do
	23	dbg [" ", "- running", show ln]
	24	let process = (Sys.shell ln) { Sys.cwd = Just ("example/" ++ sourceDir src) }
	25	(_, _, _, h) <- Sys.createProcess process
	26	Sys.waitForProcess h

+98

-0

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 :: T.Text
	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.withString "file name" pure 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" <\|> (fmap pure (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] -> ExposeFile <$> 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	loc <- B.readFile loc
	79	return (parseConfig loc)
	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	}

+61

-0

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

+24

-0

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	main :: Opt.Options -> IO ()
	17	main opts = do
	18	configMb <- Conf.getConfig (Opt.optFile opts)
	19	config <- case configMb of
	20	Left err -> Sys.die err
	21	Right x -> return x
	22	case Opt.optCommand opts of
	23	Opt.Test -> Cmd.runTest config opts
	24	Opt.Splice -> Cmd.runSplice config opts