diff options
Diffstat (limited to 'src/Config.hs')
-rw-r--r-- | src/Config.hs | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 index 0000000..7e9ad85 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,94 @@ +module Config ( + Config(..), + findConfig, + parseConfig, +) where + +import Control.Monad +import Control.Monad.Combinators + +import Data.ByteString.Lazy qualified as BS +import Data.List +import Data.Map qualified as M +import Data.Maybe +import Data.Ord +import Data.Text (Text) +import Data.Text qualified as T +import Data.YAML + +import System.Directory +import System.Exit +import System.FilePath +import System.Process + +import Job + +data Config = Config + { configJobs :: [Job] + } + +instance Semigroup Config where + a <> b = Config + { configJobs = configJobs a ++ configJobs b + } + +instance Monoid Config where + mempty = Config + { configJobs = [] + } + +instance FromYAML Config where + parseYAML = withMap "Config" $ \m -> do + let getpos = \case (Scalar pos _, _) -> pos + (Mapping pos _ _, _) -> pos + (Sequence pos _ _, _) -> pos + (Anchor pos _ _, _) -> pos + jobs <- fmap catMaybes $ forM (sortBy (comparing $ posLine . getpos) $ M.assocs m) $ \case + (Scalar _ (SStr tag), node) | ["job", name] <- T.words tag -> do + flip (withMap "Job") node $ \j -> Just <$> choice + [ cabalJob name =<< j .: "cabal" + , shellJob name =<< j .: "shell" + ] + _ -> return Nothing + return $ Config jobs + +cabalJob :: Text -> Node Pos -> Parser Job +cabalJob name = withMap "cabal job" $ \m -> do + ghcOptions <- m .:? "ghc-options" >>= \case + Nothing -> return [] + Just s -> withSeq "GHC option list" (mapM (withStr "GHC option" return)) s + + return Job + { jobName = JobName name + , jobRecipe = [ proc "cabal" $ concat [ ["build"], ("--ghc-option="++) . T.unpack <$> ghcOptions ] ] + , jobArtifacts = map (\(ArtifactName aname) -> (ArtifactName "bin", proc "cabal" ["list-bin", T.unpack aname])) [] + } + +shellJob :: Text -> Node Pos -> Parser Job +shellJob name = withSeq "shell commands" $ \xs -> do + recipe <- forM xs $ withStr "shell command" $ return . T.unpack + return Job + { jobName = JobName name + , jobRecipe = map shell recipe + , jobArtifacts = [] + } + +findConfig :: IO (Maybe FilePath) +findConfig = go "." + where + name = "minici.yaml" + go path = do + doesFileExist (path </> name) >>= \case + True -> return $ Just $ path </> name + False -> doesDirectoryExist (path </> "..") >>= \case + True -> go (path </> "..") + False -> return Nothing + +parseConfig :: FilePath -> IO Config +parseConfig path = do + contents <- BS.readFile path + case decode1 contents of + Left (pos, err) -> do + putStr $ prettyPosWithSource pos contents err + exitFailure + Right conf -> return conf |