gdritter repos bricoleur / master src / Bricoleur / Config.hs
master

Tree @master (Download .tar.gz)

Config.hs @masterraw · history · blame

{-# LANGUAGE OverloadedStrings #-}

module Bricoleur.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 :: FilePath,
    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.parseAdnot 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"
    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] -> ExposeSections <$> A.parseAdnot f
          _ -> Left "Too many arguments to sections"

      namedMap = A.withProduct "exposed fragments" $
        fmap NamedMap . mapM A.parseAdnot

parseConfig :: B.ByteString -> Either String Config
parseConfig = A.decode

getConfig :: FilePath -> IO (Either String Config)
getConfig loc = do
  conf <- B.readFile loc
  return (parseConfig conf)

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