Types.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module CLI.Types where

import AST
import Control.Exception (Exception)
import Deps (Acyclic)
import Lining (LineFormat)
import Logger (LogLevel)
import Must (Must)
import Sugar (SugarType)
import Text.Printf (printf)
import XMIR (XmirContext)

data PrintContext = PrintCtx
  { _sugar :: SugarType
  , _hideRho :: Bool
  , _abridged :: Bool
  , _line :: LineFormat
  , _margin :: Int
  , _xmirCtx :: XmirContext
  , _nonumber :: Bool
  , _compress :: Bool
  , _canonize :: Bool
  , _sequence :: Bool
  , _headers :: Bool
  , _meetPopularity :: Int
  , _meetLength :: Int
  , _focus :: Expression
  , _expression :: Maybe String
  , _label :: Maybe String
  , _meetPrefix :: Maybe String
  , _outputFormat :: IOFormat
  }

data CmdException
  = InvalidCLIArguments String
  | CouldNotReadFromStdin String
  | CouldNotDataize
  | CouldNotPrintExpressionInXMIR
  | EmptySubstsOnMatch
  | AnonymousMetaInCondition String
  | VersionMismatch String String
  deriving (Exception)

instance Show CmdException where
  show (InvalidCLIArguments msg) = printf "Invalid set of arguments: %s" msg
  show (CouldNotReadFromStdin msg) = printf "Could not read input from stdin\nReason: %s" msg
  show CouldNotDataize = "Could not dataize given expression"
  show CouldNotPrintExpressionInXMIR = "Could not print expression with --output=xmir, only expression printing is allowed"
  show EmptySubstsOnMatch = "Provided pattern was not matched, no substitutions are built"
  show (AnonymousMetaInCondition kind) =
    printf "Anonymous meta '!%s' cannot be referenced in --when, only a named one can" kind
  show (VersionMismatch expected actual) =
    printf "Version mismatch: --pin requires '%s', but this is phino %s" expected actual

data Command
  = CmdRewrite OptsRewrite
  | CmdDataize OptsDataize
  | CmdMorph OptsMorph
  | CmdExplain OptsExplain
  | CmdMerge OptsMerge
  | CmdMatch OptsMatch

data Pin = PinVersion String | PinFile FilePath

data CliArgs = CliArgs
  { _pin :: Maybe Pin
  , _command :: Command
  }

data IOFormat = XMIR | PHI | LATEX
  deriving (Eq)

instance Show IOFormat where
  show XMIR = "xmir"
  show PHI = "phi"
  show LATEX = "latex"

data OptsDataize = OptsDataize
  { _logLevel :: LogLevel
  , _logLines :: Int
  , _inputFormat :: IOFormat
  , _outputFormat :: IOFormat
  , _sugarType :: SugarType
  , _hideRho :: Bool
  , _flat :: LineFormat
  , _omitListing :: Bool
  , _omitComments :: Bool
  , _nonumber :: Bool
  , _sequence :: Bool
  , _headers :: Bool
  , _canonize :: Bool
  , _depthSensitive :: Bool
  , _shuffle :: Bool
  , _seed :: Int
  , _quiet :: Bool
  , _partial :: Bool
  , _acyclic :: Maybe Acyclic
  , _compress :: Bool
  , _maxDepth :: Int
  , _maxCycles :: Int
  , _maxSteps :: Int
  , _maxFirings :: Maybe Int
  , _margin :: Int
  , _meetPopularity :: Maybe Int
  , _meetLength :: Maybe Int
  , _hide :: [String]
  , _show :: [String]
  , _locator :: String
  , _focus :: String
  , _expression :: Maybe String
  , _label :: Maybe String
  , _meetPrefix :: Maybe String
  , _inside :: Maybe String
  , _stepsDir :: Maybe FilePath
  , _protocol :: Maybe FilePath
  , _abridged :: Bool
  , _symbolic :: Maybe FilePath
  , _inputFile :: Maybe FilePath
  }

-- The option surface of 'morph' is that of 'dataize': the two commands read the
-- same input, aim the same '_locator' at the same subterm and print through the
-- same formatting flags, differing only in the judgment they run — 𝕄, which
-- stops at the first formation it reaches, against 𝔻, which insists on bytes.
data OptsMorph = OptsMorph
  { _logLevel :: LogLevel
  , _logLines :: Int
  , _inputFormat :: IOFormat
  , _outputFormat :: IOFormat
  , _sugarType :: SugarType
  , _hideRho :: Bool
  , _flat :: LineFormat
  , _omitListing :: Bool
  , _omitComments :: Bool
  , _nonumber :: Bool
  , _sequence :: Bool
  , _headers :: Bool
  , _canonize :: Bool
  , _depthSensitive :: Bool
  , _shuffle :: Bool
  , _seed :: Int
  , _quiet :: Bool
  , _partial :: Bool
  , _deep :: Bool
  , _acyclic :: Maybe Acyclic
  , _compress :: Bool
  , _maxDepth :: Int
  , _maxCycles :: Int
  , _maxSteps :: Int
  , _maxFirings :: Maybe Int
  , _margin :: Int
  , _meetPopularity :: Maybe Int
  , _meetLength :: Maybe Int
  , _hide :: [String]
  , _show :: [String]
  , _locator :: String
  , _focus :: String
  , _expression :: Maybe String
  , _label :: Maybe String
  , _meetPrefix :: Maybe String
  , _inside :: Maybe String
  , _stepsDir :: Maybe FilePath
  , _protocol :: Maybe FilePath
  , _abridged :: Bool
  , _symbolic :: Maybe FilePath
  , _inputFile :: Maybe FilePath
  }

data OptsExplain = OptsExplain
  { _logLevel :: LogLevel
  , _logLines :: Int
  , _rules :: [FilePath]
  , _normalize :: Bool
  , _morph :: Bool
  , _dataize :: Bool
  , _contextualize :: Bool
  , _shuffle :: Bool
  , _seed :: Int
  , _targetFile :: Maybe FilePath
  }

data OptsRewrite = OptsRewrite
  { _logLevel :: LogLevel
  , _logLines :: Int
  , _inputFormat :: IOFormat
  , _outputFormat :: IOFormat
  , _sugarType :: SugarType
  , _hideRho :: Bool
  , _flat :: LineFormat
  , _must :: Must
  , _normalize :: Bool
  , _shuffle :: Bool
  , _seed :: Int
  , _omitListing :: Bool
  , _omitComments :: Bool
  , _depthSensitive :: Bool
  , _nonumber :: Bool
  , _inPlace :: Bool
  , _update :: Bool
  , _sequence :: Bool
  , _headers :: Bool
  , _canonize :: Bool
  , _compress :: Bool
  , _maxDepth :: Int
  , _maxCycles :: Int
  , _margin :: Int
  , _meetPopularity :: Maybe Int
  , _meetLength :: Maybe Int
  , _rules :: [FilePath]
  , _hide :: [String]
  , _show :: [String]
  , _locator :: String
  , _focus :: String
  , _expression :: Maybe String
  , _label :: Maybe String
  , _meetPrefix :: Maybe String
  , _breakpoint :: Maybe String
  , _targetFile :: Maybe FilePath
  , _stepsDir :: Maybe FilePath
  , _inputFile :: Maybe FilePath
  }

data OptsMerge = OptsMerge
  { _logLevel :: LogLevel
  , _logLines :: Int
  , _inputFormat :: IOFormat
  , _outputFormat :: IOFormat
  , _sugarType :: SugarType
  , _flat :: LineFormat
  , _omitListing :: Bool
  , _omitComments :: Bool
  , _margin :: Int
  , _targetFile :: Maybe FilePath
  , _inputs :: [FilePath]
  , _seed :: Int
  }

data OptsMatch = OptsMatch
  { _logLevel :: LogLevel
  , _logLines :: Int
  , _sugarType :: SugarType
  , _flat :: LineFormat
  , _pattern :: Maybe String
  , _when :: Maybe String
  , _inputFile :: Maybe FilePath
  , _seed :: Int
  }