{-|
Copyright        : (c) Galois, Inc. 2025
Maintainer       : Langston Barrett <langston@galois.com>
-}

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Lang.Crucible.Debug.Command
  ( Command(..)
  , CommandExt(..)
  , voidExts
  , allCmds
  , name
  , abbrev
  , parse
  , detail
  , help
  , regex
  ) where

import Data.List qualified as List
import Data.Parameterized.Some (Some)
import Data.Text (Text)
import Data.Void (Void, absurd)
import Lang.Crucible.Debug.Arg.Type (ArgTypeRepr)
import Lang.Crucible.Debug.Command.Base qualified as BCmd
import Lang.Crucible.Debug.Regex qualified as Rgx
import Prettyprinter qualified as PP

data CommandExt cExt
  = CommandExt
  { -- | Used in 'abbrev', 'parse'
    forall cExt. CommandExt cExt -> cExt -> Text
extAbbrev :: cExt -> Text
  , forall cExt. CommandExt cExt -> [cExt]
extList :: [cExt]
    -- | Multi-line help string. Used in 'detail'.
    --
    -- This is always displayed as a new paragraph following 'extHelp', so it
    -- should not repeat the information there.
    --
    -- Should be long-form prose, with proper capitalization and punctuation.
    -- Should not rely on being shown in monospaced font.
  , forall cExt. CommandExt cExt -> cExt -> Maybe Text
extDetail :: cExt -> Maybe Text
    -- | Single-line help string. Used in 'help'.
    --
    -- The first letter should be capitalized, it should not end in a period.
    -- It should probably be less than about 70 characters long.
  , forall cExt. CommandExt cExt -> cExt -> Text
extHelp :: cExt -> Text
    -- | Used in 'help', 'parse'
  , forall cExt. CommandExt cExt -> cExt -> Text
extName :: cExt -> Text
    -- | Used in 'help'
  , forall cExt.
CommandExt cExt -> cExt -> Some (RegexRepr ArgTypeRepr)
extRegex :: cExt -> Some (Rgx.RegexRepr ArgTypeRepr)
  }

voidExts :: CommandExt Void
voidExts :: CommandExt Void
voidExts =
  CommandExt
  { extAbbrev :: Void -> Text
extAbbrev = Void -> Text
forall a. Void -> a
absurd
  , extDetail :: Void -> Maybe Text
extDetail = Void -> Maybe Text
forall a. Void -> a
absurd
  , extHelp :: Void -> Text
extHelp = Void -> Text
forall a. Void -> a
absurd
  , extList :: [Void]
extList = []
  , extName :: Void -> Text
extName = Void -> Text
forall a. Void -> a
absurd
  , extRegex :: Void -> Some (RegexRepr ArgTypeRepr)
extRegex = Void -> Some (RegexRepr ArgTypeRepr)
forall a. Void -> a
absurd
  }

data Command cExt
  = Base BCmd.BaseCommand
  | Ext cExt
  deriving ((forall a b. (a -> b) -> Command a -> Command b)
-> (forall a b. a -> Command b -> Command a) -> Functor Command
forall a b. a -> Command b -> Command a
forall a b. (a -> b) -> Command a -> Command b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Command a -> Command b
fmap :: forall a b. (a -> b) -> Command a -> Command b
$c<$ :: forall a b. a -> Command b -> Command a
<$ :: forall a b. a -> Command b -> Command a
Functor, Int -> Command cExt -> ShowS
[Command cExt] -> ShowS
Command cExt -> String
(Int -> Command cExt -> ShowS)
-> (Command cExt -> String)
-> ([Command cExt] -> ShowS)
-> Show (Command cExt)
forall cExt. Show cExt => Int -> Command cExt -> ShowS
forall cExt. Show cExt => [Command cExt] -> ShowS
forall cExt. Show cExt => Command cExt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall cExt. Show cExt => Int -> Command cExt -> ShowS
showsPrec :: Int -> Command cExt -> ShowS
$cshow :: forall cExt. Show cExt => Command cExt -> String
show :: Command cExt -> String
$cshowList :: forall cExt. Show cExt => [Command cExt] -> ShowS
showList :: [Command cExt] -> ShowS
Show)

instance PP.Pretty cExt => PP.Pretty (Command cExt) where
  pretty :: forall ann. Command cExt -> Doc ann
pretty =
    \case
      Base BaseCommand
bCmd -> BaseCommand -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. BaseCommand -> Doc ann
PP.pretty BaseCommand
bCmd
      Ext cExt
xCmd -> cExt -> Doc ann
forall ann. cExt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty cExt
xCmd

name :: CommandExt cExt -> Command cExt -> Text
name :: forall cExt. CommandExt cExt -> Command cExt -> Text
name CommandExt cExt
cExts =
  \case
    Base BaseCommand
bCmd -> BaseCommand -> Text
BCmd.name BaseCommand
bCmd
    Ext cExt
xCmd -> CommandExt cExt -> cExt -> Text
forall cExt. CommandExt cExt -> cExt -> Text
extName CommandExt cExt
cExts cExt
xCmd

abbrev :: CommandExt cExt -> Command cExt -> Text
abbrev :: forall cExt. CommandExt cExt -> Command cExt -> Text
abbrev CommandExt cExt
cExts =
  \case
    Base BaseCommand
bCmd -> BaseCommand -> Text
BCmd.abbrev BaseCommand
bCmd
    Ext cExt
xCmd -> CommandExt cExt -> cExt -> Text
forall cExt. CommandExt cExt -> cExt -> Text
extAbbrev CommandExt cExt
cExts cExt
xCmd

allCmds :: CommandExt cExt -> [Command cExt]
allCmds :: forall cExt. CommandExt cExt -> [Command cExt]
allCmds CommandExt cExt
cExts = (BaseCommand -> Command cExt) -> [BaseCommand] -> [Command cExt]
forall a b. (a -> b) -> [a] -> [b]
map BaseCommand -> Command cExt
forall cExt. BaseCommand -> Command cExt
Base [BaseCommand
forall a. Bounded a => a
minBound..BaseCommand
forall a. Bounded a => a
maxBound] [Command cExt] -> [Command cExt] -> [Command cExt]
forall a. [a] -> [a] -> [a]
++ (cExt -> Command cExt) -> [cExt] -> [Command cExt]
forall a b. (a -> b) -> [a] -> [b]
map cExt -> Command cExt
forall cExt. cExt -> Command cExt
Ext (CommandExt cExt -> [cExt]
forall cExt. CommandExt cExt -> [cExt]
extList CommandExt cExt
cExts)

parse :: CommandExt cExt -> Text -> Maybe (Command cExt)
parse :: forall cExt. CommandExt cExt -> Text -> Maybe (Command cExt)
parse CommandExt cExt
cExts Text
txt =
  (Command cExt -> Bool) -> [Command cExt] -> Maybe (Command cExt)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Command cExt
c -> CommandExt cExt -> Command cExt -> Text
forall cExt. CommandExt cExt -> Command cExt -> Text
name CommandExt cExt
cExts Command cExt
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
txt Bool -> Bool -> Bool
|| CommandExt cExt -> Command cExt -> Text
forall cExt. CommandExt cExt -> Command cExt -> Text
abbrev CommandExt cExt
cExts Command cExt
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
txt) (CommandExt cExt -> [Command cExt]
forall cExt. CommandExt cExt -> [Command cExt]
allCmds CommandExt cExt
cExts)

detail :: CommandExt cExt -> Command cExt -> Maybe Text
detail :: forall cExt. CommandExt cExt -> Command cExt -> Maybe Text
detail CommandExt cExt
cExts =
  \case
    Base BaseCommand
bCmd -> BaseCommand -> Maybe Text
BCmd.detail BaseCommand
bCmd
    Ext cExt
xCmd -> CommandExt cExt -> cExt -> Maybe Text
forall cExt. CommandExt cExt -> cExt -> Maybe Text
extDetail CommandExt cExt
cExts cExt
xCmd

help :: CommandExt cExt -> Command cExt -> Text
help :: forall cExt. CommandExt cExt -> Command cExt -> Text
help CommandExt cExt
cExts =
  \case
    Base BaseCommand
bCmd -> BaseCommand -> Text
BCmd.help BaseCommand
bCmd
    Ext cExt
xCmd -> CommandExt cExt -> cExt -> Text
forall cExt. CommandExt cExt -> cExt -> Text
extHelp CommandExt cExt
cExts cExt
xCmd

regex :: CommandExt cExt -> Command cExt -> Some (Rgx.RegexRepr ArgTypeRepr)
regex :: forall cExt.
CommandExt cExt -> Command cExt -> Some (RegexRepr ArgTypeRepr)
regex CommandExt cExt
cExts =
  \case
    Base BaseCommand
bCmd -> BaseCommand -> Some (RegexRepr ArgTypeRepr)
BCmd.regex BaseCommand
bCmd
    Ext cExt
xCmd -> CommandExt cExt -> cExt -> Some (RegexRepr ArgTypeRepr)
forall cExt.
CommandExt cExt -> cExt -> Some (RegexRepr ArgTypeRepr)
extRegex CommandExt cExt
cExts cExt
xCmd