bricoleur/src/Collage/Config.hs

{-# 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"]
        }
    ]
  }