{-|
Module : Cmd.Ebnf
Description : CLI for the `pp ebnf` command
Copyright : (c) 2017 Patrick Champion
License : see LICENSE file
Maintainer : chlablak@gmail.com
Stability : provisional
Portability : portable
-}
module Cmd.Ebnf
( commandArgs
, dispatch
) where
import Args
import Control.Monad (when)
import qualified Data.Map.Strict as Map
import Data.Semigroup ((<>))
import qualified Log
import Options.Applicative
import qualified PP
import qualified PP.Grammars.Ebnf as Ebnf
-- |Command arguments
commandArgs :: Parser CommandArgs
commandArgs = EbnfCmd <$> ebnfArgs
where
ebnfArgs = EbnfArgs
<$> strOption ( long "file"
<> short 'f'
<> metavar "FILENAME"
<> help "Input file" )
<*> switch ( long "minify"
<> help "Print the minified grammar" )
<*> switch ( long "rules"
<> help "Print the obtained rules" )
<*> switch ( long "first"
<> help "Print the first set" )
<*> switch ( long "check"
<> help "Search for errors" )
<*> switch ( long "lexical"
<> help "Print lexical rules" )
<*> switch ( long "regexfy"
<> help "Print regexfied lexical rules" )
-- |Command dispatch
dispatch :: Args -> Log.Logger
dispatch (Args _ (EbnfCmd args)) = do
Log.pushTag "ebnf"
input <- Log.io $ readFile $ ebnfFile args
case PP.parseAst input :: (PP.To Ebnf.Syntax) of
Left err -> do
Log.err $ "error in file '" ++ ebnfFile args ++ "':"
Log.err $ show err
Log.abort
Right ast -> do
-- Flag `--minify`
when (showMinified args) $ do
Log.info "minified:"
Log.out $ PP.stringify ast
r <- Log.io $ PP.rules' $ PP.lexify ast
case r of
Left err -> do
Log.err $ "cannot make rules: " ++ err
Log.abort
Right r -> do
let (prs, lrs) = PP.separate r
-- Flag `--lexical`
when (showLexical args) $ do
Log.info "lexical rules:"
mapM_ (Log.out . show) lrs
-- Flag `--regexfy`
when (showRegexfied args) $ do
Log.info "regexfied lexical rules:"
mapM_ (Log.out . show) $ PP.regexfy lrs
case PP.extend prs of
Left err -> do
Log.err "cannot extend the input grammar:"
Log.err err
Log.abort
Right g' -> do
let rs = PP.ruleSet g'
let fs = PP.firstSet rs
-- Flag `--rules`
when (showRules args) $ do
Log.info "rules:"
mapM_ (Log.out . show) g'
-- Flag `--first`
when (showFirstSet args) $ do
Log.info "first set:"
mapM_ (Log.out . show) $ Map.toList fs
-- Flag `--check`
when (doCheck args) $ do
let (err, warn) = PP.check rs
Log.pushTag "check"
Log.info "errors:"
mapM_ Log.info err
Log.info "warnings:"
mapM_ Log.info warn
Log.popTag
-- End
Log.popTag
return ()