Basic scaffolding for eventual collage program

.gitignore

@@ -0,0 +1,20 @@
+dist
+dist-*
+*~
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+cabal.project.local
+.ghc.environment.*

collage.cabal

@@ -0,0 +1,42 @@
+cabal-version: 2.2
+name: collage
+version: 0.1.0.0
+-- synopsis:
+-- description:
+license: BSD-3-Clause
+author: Getty Ritter <gettylefou@gmail.com>
+maintainer: Getty Ritter <gettylefou@gmail.com>
+copyright: @2018 Getty Ritter
+-- category:
+build-type: Simple
+
+
+library
+  hs-source-dirs: src
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5
+               , adnot
+               , bytestring
+               , containers
+               , directory
+               , filepath
+               , optparse-applicative
+               , process
+               , text
+               , vector
+  default-language: Haskell2010
+  default-extensions: ScopedTypeVariables
+  exposed-modules: Collage
+                 , Collage.Config
+                 , Collage.Opts
+                 , Collage.Commands.Test
+                 , Collage.Commands.Splice
+
+executable collage
+  hs-source-dirs: collage
+  main-is: Main.hs
+  default-language: Haskell2010
+  default-extensions: ScopedTypeVariables
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5
+               , collage

collage/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import qualified Collage
+
+main :: IO ()
+main = Collage.getOpts >>= Collage.main

src/Collage.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Collage
+( main
+, Opt.getOpts
+) where
+
+import qualified System.Exit as Sys
+
+import qualified Collage.Config as Conf
+import qualified Collage.Opts as Opt
+
+import qualified Collage.Commands.Splice as Cmd
+import qualified Collage.Commands.Test as Cmd
+
+main :: Opt.Options -> IO ()
+main opts = do
+  configMb <- Conf.getConfig (Opt.optFile opts)
+  config <- case configMb of
+    Left err -> Sys.die err
+    Right x -> return x
+  case Opt.optCommand opts of
+    Opt.Test   -> Cmd.runTest config opts
+    Opt.Splice -> Cmd.runSplice config opts

src/Collage/Commands/Splice.hs

@@ -0,0 +1,7 @@
+module Collage.Commands.Splice (runSplice) where
+
+import Collage.Config
+import Collage.Opts
+
+runSplice :: Config -> Options -> IO ()
+runSplice _ _ = putStrLn "Unimplemented!"

src/Collage/Commands/Test.hs

@@ -0,0 +1,26 @@
+module Collage.Commands.Test (runTest) where
+
+import           Control.Monad (forM_)
+import qualified Data.Text as T
+import qualified System.Process as Sys
+
+import Collage.Opts
+import Collage.Config
+
+dbg :: [String] -> IO ()
+dbg = putStrLn . unwords
+
+runTest :: Config -> Options -> IO ()
+runTest conf _ = do
+  dbg ["testing", T.unpack (confDocument conf) ]
+  forM_ (confSources conf) $ \ samp -> do
+    dbg ["-", "building source", T.unpack (sourceName samp) ]
+    runCommand samp
+
+runCommand :: Source -> IO ()
+runCommand src = do
+  forM_ (sourceCommands src) $ \ln -> do
+    dbg [" ", "- running", show ln]
+    let process = (Sys.shell ln) { Sys.cwd = Just ("example/" ++ sourceDir src) }
+    (_, _, _, h) <- Sys.createProcess process
+    Sys.waitForProcess h

src/Collage/Config.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Collage.Config
+( Config(..)
+, Source(..)
+, Expose(..)
+, getConfig
+, example
+) where
+
+import           Control.Applicative ((<|>))
+import qualified Data.Adnot as A
+import qualified Data.ByteString as B
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Data.Vector as V
+
+data Config = Config
+  { confDocument :: T.Text
+  , confSources :: [Source]
+  } deriving (Eq, Show)
+
+instance A.FromAdnot Config where
+  parseAdnot = A.withSumNamed "config file" "document" go
+    where
+      go payload
+        | Just file <- payload V.!? 0
+        = Config <$> A.withString "file name" pure file
+                 <*> mapM A.parseAdnot (V.toList (V.tail payload))
+        | otherwise = Left "expected source file in config"
+
+
+data Source = Source
+  { sourceName     :: T.Text
+  , sourceDir      :: FilePath
+  , sourceCommands :: [String]
+  , sourceExpose   :: [Expose]
+  } deriving (Eq, Show)
+
+instance A.FromAdnot Source where
+  parseAdnot = A.withProduct "source" $ \p -> do
+    name   <- p A..: "name"
+    dir    <- p A..: "dir"
+    cmds   <- p A..: "cmd"
+    expose <- p A..: "expose" <|> (fmap pure (p A..: "expose"))
+    return (Source name dir cmds expose)
+
+
+data Expose
+  = ExposeFile FilePath
+  | ExposeSections FilePath
+  | NamedMap (M.Map T.Text Expose)
+    deriving (Eq, Show)
+
+instance A.FromAdnot Expose where
+  parseAdnot v = file v <|> sections v <|> namedMap v
+    where
+      file = A.withSumNamed "exposed fragments" "file" $ \ ps ->
+        case V.toList ps of
+          []  -> Left "Expected name for file"
+          [f] -> ExposeFile <$> A.parseAdnot f
+          _   -> Left "Too many arguments to file"
+
+      sections = A.withSumNamed "exposed fragments" "sections" $ \ ps ->
+        case V.toList ps of
+          []  -> Left "Expected name for sections"
+          [f] -> ExposeFile <$> A.parseAdnot f
+          _   -> Left "Too many arguments to sections"
+
+      namedMap = A.withProduct "exposed fragments" $ \ p ->
+        NamedMap <$> mapM A.parseAdnot p
+
+parseConfig :: B.ByteString -> Either String Config
+parseConfig = A.decode
+
+getConfig :: FilePath -> IO (Either String Config)
+getConfig loc = do
+  loc <- B.readFile loc
+  return (parseConfig loc)
+
+example :: Config
+example = Config
+  { confDocument = "main.md"
+  , confSources =
+    [ Source
+        { sourceName = "rust-sample"
+        , sourceDir = "s1"
+        , sourceCommands = ["cargo clean", "cargo build"]
+        , sourceExpose = [ExposeFile "src/main.rs"]
+        }
+    , Source
+        { sourceName = "haskell-sample"
+        , sourceDir = "s2"
+        , sourceCommands = ["cabal new-build"]
+        , sourceExpose = [ExposeSections "Main.hs"]
+        }
+    ]
+  }

src/Collage/Opts.hs

@@ -0,0 +1,61 @@
+module Collage.Opts
+( Command(..)
+, Options(..)
+, getOpts
+) where
+
+import           Control.Applicative ((<|>))
+import qualified Options.Applicative as Opt
+import qualified System.Directory as Sys
+import qualified System.FilePath as Sys
+
+data Command
+  = Test
+  | Splice
+    deriving (Eq, Show)
+
+data Options = Options
+  { optFile    :: FilePath
+  , optVerbose :: Bool
+  , optCommand :: Command
+  } deriving (Eq, Show)
+
+desc :: String
+desc = "FINISH ME"
+
+opts :: Opt.ParserInfo Options
+opts = Opt.info (p Opt.<**> Opt.helper)
+         (Opt.progDesc desc <>
+          Opt.fullDesc <>
+          Opt.header "arglbargl")
+  where
+    p = Options <$> (path <|> pure "")
+                <*> verbose
+                <*> Opt.subparser (test <> splice)
+
+    path = Opt.strOption
+             (Opt.short 'f' <>
+              Opt.long "file" <>
+              Opt.metavar "PATH" <>
+              Opt.help "The path to the project file")
+
+    verbose = Opt.switch
+                (Opt.short 'v' <>
+                 Opt.long "verbose" <>
+                 Opt.help "Show debug messages")
+
+    test = Opt.command "test" $ Opt.info
+             (pure Test Opt.<**> Opt.helper)
+             (Opt.progDesc "test the provided sources")
+
+    splice = Opt.command "splice" $ Opt.info
+               (pure Splice Opt.<**> Opt.helper)
+               (Opt.progDesc "splice sources into a final draft")
+
+getOpts :: IO Options
+getOpts = do
+  cwd <- Sys.getCurrentDirectory
+  options <- Opt.execParser opts
+  return $ if null (optFile options)
+              then options { optFile = cwd Sys.</> "collage" }
+              else options