juvix/app/Commands/Termination.hs

{-# LANGUAGE ApplicativeDo #-}
module Commands.Termination where

import Commands.Extra
import qualified Data.Text as Text
import Control.Monad.Extra
import Options.Applicative
import qualified MiniJuvix.Syntax.Abstract.Pretty.Base as A
import MiniJuvix.Prelude hiding (Doc)

data TerminationCommand =
  Calls CallsOptions
  | CallGraph CallGraphOptions

data CallsOptions = CallsOptions
  { _callsInputFile :: FilePath,
    _callsShowIds :: Bool,
    _callsFunctionNameFilter :: Maybe (NonEmpty Text),
    _callsShowDecreasingArgs :: A.ShowDecrArgs
  }

data CallGraphOptions = CallGraphOptions
  { _graphInputFile :: FilePath,
    _graphFunctionNameFilter :: Maybe (NonEmpty Text)
  }

parseCalls :: Parser CallsOptions
parseCalls = do
  _callsInputFile <- parseInputFile
  _callsShowIds <-
    switch
      ( long "show-name-ids"
          <> help "Show the unique number of each identifier"
      )
  _callsFunctionNameFilter <-
    fmap msum . optional $ nonEmpty . Text.words <$> option str
      ( long "function"
          <> short 'f'
          <> metavar "fun1 fun2 ..."
          <> help "Only shows the specified functions"
      )
  _callsShowDecreasingArgs <-
    option decrArgsParser
      ( long "show-decreasing-args"
          <> short 'd'
          <> value A.ArgRel
          <> help "possible values: argument, relation, both"
      )
  pure CallsOptions {..}
  where
  decrArgsParser :: ReadM A.ShowDecrArgs
  decrArgsParser = eitherReader $ \s ->
    case map toLower s of
      "argument" -> return A.OnlyArg
      "relation" -> return A.OnlyRel
      "both" -> return A.ArgRel
      _ -> Left "bad argument"


parseCallGraph :: Parser CallGraphOptions
parseCallGraph = do
  _graphInputFile <- parseInputFile
  _graphFunctionNameFilter <-
    fmap msum . optional $ nonEmpty . Text.words <$> option str
      ( long "function"
          <> short 'f'
          <> help "Only shows the specified function"
      )
  pure CallGraphOptions {..}

parseTerminationCommand :: Parser TerminationCommand
parseTerminationCommand =
  hsubparser $
    mconcat
      [ commandCalls,
        commandGraph
      ]
  where
    commandCalls :: Mod CommandFields TerminationCommand
    commandCalls = command "calls" minfo
      where
        minfo :: ParserInfo TerminationCommand
        minfo =
          info
            (Calls <$> parseCalls)
            (progDesc "Compute the calls table of a .mjuvix file")
    commandGraph :: Mod CommandFields TerminationCommand
    commandGraph = command "graph" minfo
      where
        minfo :: ParserInfo TerminationCommand
        minfo =
          info
            (CallGraph <$> parseCallGraph)
            (progDesc "Compute the complete call graph of a .mjuvix file")

callsPrettyOptions :: CallsOptions -> A.Options
callsPrettyOptions CallsOptions {..} =
  A.defaultOptions
    { A._optShowNameId = _callsShowIds,
      A._optShowDecreasingArgs = _callsShowDecreasingArgs
    }