content: -- Program to test parser, automatically generated by BNF Converter.
  
  module L4.Executable where
  
  import System.Environment ( getArgs )
  import System.Exit        ( exitFailure, exitSuccess )
  import Control.Monad      ( when )
  import Options.Applicative
  
  import Data.List.Split (splitOn)
  import Data.Either (lefts, rights)
  import Text.Pretty.Simple
  import Data.Maybe (isJust)
  import Data.Char (toLower)
  import Data.List (intercalate)
  import qualified Data.Text.Lazy as T
  import LexL    ( Token )
  import ParL    ( pTops, myLexer )
  import SkelL   ()
  import PrintL  ( printTree )
  import AbsL    ( Tops(..), Rule(..), RuleBody(..), MatchVars(..), Toplevels(..) )
  import LayoutL ( resolveLayout )
  import ToGraphViz
  import L4
  import ToGF (bnfc2lang)
  import PGF (PGF, readPGF)
  
  
  type Err = Either String
  type ParseFun a = [Token] -> Err a
  
  myLLexer = resolveLayout True . myLexer
  
  type Verbosity = Int
  
  putStrV :: Verbosity -> String -> IO ()
  putStrV v s = when (v > 1) $ putStrLn s
  
  run :: Verbosity -> PGF -> ParseFun Tops -> InputOpts -> String -> IO ()
  run v gr p inOpt s = case p ts of
      Left notTree -> do
        putStrLn "\nParse              Failed...\n"
        putStrV v "Tokens:"
        putStrV v $ show ts
        putStrLn notTree
        exitFailure
      Right tree -> do
        showTree inOpt gr v tree
        exitSuccess
    where
    ts = myLLexer s
  
  
  simpleParseTree :: String  -> Err Tops
  simpleParseTree = pTops . myLLexer
  
  prettyPrintParseTree :: String -> Either String T.Text
  prettyPrintParseTree = fmap pShowNoColor . simpleParseTree
  
  showTree :: InputOpts -> PGF -> Int -> Tops -> IO ()
  showTree inOpts gr v tree0 = do
    let tree = rewriteTree tree0 
        ruleList = getRules tree 
        want f = format inOpts `elem` [Fall] || f (format inOpts)
    when (want (==Fast)) $ do
      print $ T.unpack (pShowNoColor tree)
    when (want (==Flin)) $ do
      putStrLn $ printTree tree
    when (want (==Fgraph)) $ do -- the fgl version of what becomes the dotfile
      printGraph ruleList
    when (want (==Fdot)) $ do
      -- dotfile output 
      putStrLn $ showDot ruleList
      writeFile "graph.dot" (showDot ruleList)
    when (want (==Fjson)) $ do
      -- json output
      putStrLn $ "{ \"under construction\": \"true\" }"
    when (want (==Fmisc)) $ do
      -- not quite sure what this is for
      let miscopts x = x `elem` misc inOpts
      when (miscopts Mnames)    $ printMsg "Just the Names" $ unlines $ showRuleName <$> ruleList
      when (miscopts Mnamelist) $ printMsg "Dictionary of Name to Rule" $ T.unpack (pShow $ nameList ruleList)
      when (miscopts Mexits)    $ printMsg "Rule to Exit" $ T.unpack $ pShow $ (\r -> (showRuleName r, ruleExits r)) <$> ruleList
    when (want wantGF) $ do
      putStrLn $ bnfc2lang (getGFlang (format inOpts)) gr tree
    where
      printMsg msg result = putStrV v $ "\n[" ++ msg ++ "]\n\n" ++ result
      wantGF (Fgf _) = True
      wantGF Fall    = True
      wantGF _       = False
      getGFlang (Fgf gflang) = gflang
      getGFlang Fall         = GFeng -- default to english
  
  rewriteTree :: Tops -> Tops
  rewriteTree (Toplevel tops) = Toplevel $ do
    (ToplevelsRule r@(Rule rdef rname asof metalimb rulebody)) <- tops
    ToplevelsRule <$> case rulebody of
      RMatch mvs -> do
        (MatchRule innerRule) <- mvs
        rewrite innerRule
      otherwise -> rewrite r
  
  data Format = Fall | Fdot | Fast | Flin | Fjson | Fgraph | Fgf GFlang | Fmisc deriving (Show, Eq)
  
  -- GFlang is defined in L4.hs
  data MiscOpts = Mnames | Mnamelist | Mexits deriving (Show, Eq)
  
  parseMiscOpts :: ReadM [MiscOpts]
  parseMiscOpts = eitherReader $ \miscopts ->
    (let firstParse = [ case (toLower <$> misc) of
                          "names"    -> Right Mnames
                          "namelist" -> Right Mnamelist
                          "exits"    -> Right Mexits
                          x          -> Left $ "unable to parse miscellaneous option " ++ x
                      | misc <- splitOn "," miscopts ]
     in if (not (null (lefts firstParse)))
        then Left  (intercalate "; " (lefts firstParse))
        else Right (rights firstParse)
    )
  
  data InputOpts = InputOpts 
    { format :: Format 
    , misc   :: [MiscOpts]
    , silent :: Bool
    } deriving Show
  
  optsParse :: Parser InputOpts
  optsParse = InputOpts <$>
        subparser
          ( command "all" (info (pure Fall) (progDesc "Prints all available formats"))
         <> command "dot" (info (pure Fdot) (progDesc "Prints dot format only"))
         <> command "ast" (info (pure Fast) (progDesc "Prints ast format only"))
         <> command "json" (info (pure Fjson) (progDesc "Prints json format only"))
         <> command "png" (info (pure Fgraph) (progDesc "Prints png format only"))
         <> command "gf" (info (subparser (command "en" (info (pure (Fgf GFeng))   (progDesc "tell GF to output english")) <>
                                           command "my" (info (pure (Fgf GFmalay)) (progDesc "tell GF to output malay")))
                                <**> helper)
                            (fullDesc <> progDesc "subcommand: en, my"))
                          ) 
    <*> option parseMiscOpts -- > nix-shell --run 'stack run -- l4 --format misc --misc names < l4/test.l4'
          ( long "misc"
            <> value [Mnames, Mnamelist, Mexits]
            <> help "miscellaneous options (names, namelist, exits)" )
    <*> switch
          ( long "silent"
         <> short 's'
         <> help "Enables silent output" )
  
  main :: IO ()
  main = do  
    let optsParse' = info optsParse (fullDesc <> progDesc "l4 - a parser for l4")
    opts <- customExecParser (prefs showHelpOnError) optsParse'
  
    stdin <- getContents
                                
    let vb = if silent opts then 0 else 2
    gr <- readPGF "src-l4/Top.pgf"
    run vb gr pTops opts stdin 
  
  
  