{-| Module : Cmd.Build Description : CLI for the `pp build` command Copyright : (c) 2017 Patrick Champion License : see LICENSE file Maintainer : chlablak@gmail.com Stability : provisional Portability : portable -} module Cmd.Build ( commandArgs , dispatch ) where import Args import qualified Cmd.Ebnf import qualified Cmd.Lalr import Control.Monad (unless, when) import Data.Semigroup ((<>)) import qualified Log import Options.Applicative import qualified Project -- |Command arguments commandArgs :: Parser CommandArgs commandArgs = BuildCmd <$> buildArgs where buildArgs = BuildArgs <$> switch ( long "no-template" <> help "Disable templates compilation" ) <*> switch ( long "no-test" <> help "Disable tests execution" ) <*> strOption ( long "test-with" <> short 't' <> metavar "FILENAME" <> value "" <> help "Test the grammar on a source file" ) <*> switch ( long "ast" <> help "Print the parsed AST (with --test-with)" ) <*> strOption ( long "ast-to-html" <> metavar "FILENAME" <> value "" <> help "Output the parsed AST to HTML list" ) -- |Command dispatch dispatch :: Args -> Log.Logger dispatch (Args cargs0 (BuildCmd args)) = do Log.pushTag "build" -- Parse pp.yaml p <- Project.get case p of Project.NoProject -> Log.err "no project in current directory" Project.MalformedProject err -> Log.err $ "malformed project: " ++ err _ -> do Log.info $ "build project: " ++ Project.projectName p let cargs = mergeCArgs cargs0 p let file = head $ Project.projectGrammars p -- EBNF checks Log.info "EBNF checks:" let ebnf = EbnfArgs file False False False True False False Cmd.Ebnf.dispatch $ Args cargs $ EbnfCmd ebnf checkOk <- Log.ok when checkOk $ do -- LALR generation Log.info "LALR generation:" let lalr = LalrArgs file False (-1) False (buildTestWith args) "" False (buildShowAst args) (buildAstHtml args) Cmd.Lalr.dispatch $ Args cargs $ LalrCmd lalr genOk <- Log.ok when genOk $ do -- Templates compilation unless (disableTemplate args) $ do Log.info "Templates compilation:" Log.autoFlush False mapM_ (buildTemplate cargs lalr) $ Project.projectTemplates p Log.autoFlush True -- Tests unless (disableTest args) $ do Log.info "Tests execution:" Log.autoFlush False mapM_ (buildTest cargs lalr) $ Project.projectTests p Log.autoFlush True -- End Log.popTag return () -- |Compute the correct common args mergeCArgs :: CommonArgs -> Project.Project -> CommonArgs mergeCArgs (CommonArgs l s _ p) pr = CommonArgs l s (Project.projectUseWork pr) p -- |Build template buildTemplate :: CommonArgs -> LalrArgs -> Project.ProjectTemplate -> Log.Logger buildTemplate cargs (LalrArgs l1 l2 l3 l4 l5 _ l7 l8 l9) t = do Log.pushTag "template" Log.info $ Project.templateFile t ++ " > " ++ Project.templateDst t Log.flushAll let args = LalrArgs l1 l2 l3 l4 l5 (Project.templateFile t) l7 l8 l9 Cmd.Lalr.dispatch $ Args cargs $ LalrCmd args Log.flushOutToFile $ Project.templateDst t Log.popTag -- |Build test buildTest :: CommonArgs -> LalrArgs -> Project.ProjectTest -> Log.Logger buildTest cargs (LalrArgs l1 l2 l3 l4 _ l6 l7 _ l9) t = do Log.pushTag "test" Log.info $ Project.testFile t ++ if Project.testAstDst t /= "" then " > " ++ Project.testAstDst t else "" Log.flushAll let args = LalrArgs l1 l2 l3 l4 (Project.testFile t) l6 l7 (Project.testAstDst t /= "") l9 Cmd.Lalr.dispatch $ Args cargs $ LalrCmd args if Project.testAstDst t /= "" then Log.flushOutToFile $ Project.testAstDst t else Log.flushOutOnly Log.popTag