{-# options_haddock prune #-}

-- |Compute the command options and arguments based on handler function parameters.
module Ribosome.Host.Handler.Command where

import Type.Errors.Pretty (type (%), type (<>))

import Ribosome.Host.Data.Args (ArgList, Args, JsonArgs, Options)
import Ribosome.Host.Data.Bang (Bang)
import Ribosome.Host.Data.Bar (Bar)
import Ribosome.Host.Data.CommandMods (CommandMods)
import Ribosome.Host.Data.CommandRegister (CommandRegister)
import Ribosome.Host.Data.Range (Range, RangeStyleOpt (rangeStyleArg, rangeStyleOpt))
import Data.MessagePack (Object)
import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)

-- |Represents the value for the command option @-nargs@.
data ArgCount =
  -- |@-nargs=0@
  Zero
  |
  -- |@-nargs=*@
  MinZero
  |
  -- |@-nargs=+@
  MinOne
  deriving stock (ArgCount -> ArgCount -> Bool
(ArgCount -> ArgCount -> Bool)
-> (ArgCount -> ArgCount -> Bool) -> Eq ArgCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgCount -> ArgCount -> Bool
$c/= :: ArgCount -> ArgCount -> Bool
== :: ArgCount -> ArgCount -> Bool
$c== :: ArgCount -> ArgCount -> Bool
Eq, Int -> ArgCount -> ShowS
[ArgCount] -> ShowS
ArgCount -> String
(Int -> ArgCount -> ShowS)
-> (ArgCount -> String) -> ([ArgCount] -> ShowS) -> Show ArgCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgCount] -> ShowS
$cshowList :: [ArgCount] -> ShowS
show :: ArgCount -> String
$cshow :: ArgCount -> String
showsPrec :: Int -> ArgCount -> ShowS
$cshowsPrec :: Int -> ArgCount -> ShowS
Show)

type family Max (l :: ArgCount) (r :: ArgCount) :: ArgCount where
  Max 'Zero r = r
  Max 'MinZero 'MinOne = 'MinOne
  Max l _ = l

-- |Determines how different special command handler parameter types may interact.
data OptionState =
  OptionState {
    -- |Are special option parameters allowed at this position?
    OptionState -> Bool
allowed :: Bool,
    -- |The minimum number of arguments that are expected
    OptionState -> ArgCount
minArgs :: ArgCount,
    -- |Have all arguments been consumed, by types like 'ArgList'?
    OptionState -> Maybe (*)
argsConsumed :: Maybe Type
  }

type OptionStateZero =
  'OptionState 'True 'Zero 'Nothing

type family CommandSpecial (a :: Type) :: Bool where
  CommandSpecial (Range _) = 'True
  CommandSpecial Bang = 'True
  CommandSpecial Bar = 'True
  CommandSpecial CommandMods = 'True
  CommandSpecial CommandRegister = 'True
  CommandSpecial Args = 'True
  CommandSpecial ArgList = 'True
  CommandSpecial (JsonArgs _) = 'True
  CommandSpecial (Options _) = 'True
  CommandSpecial _ = 'False

-- |Determine the command options and arguments that need to be specified when registering a command, for a special
-- command option parameter.
--
-- See [Command params]("Ribosome#command-params") for the list of supported special types.
class SpecialParam (state :: OptionState) (a :: Type) where
  type TransSpecial state a :: OptionState
  type TransSpecial s _ =
    s

  specialOpt :: Map Text Object
  specialOpt =
    Map Text Object
forall a. Monoid a => a
mempty

  specialArg :: Maybe Text
  specialArg =
    Maybe Text
forall a. Maybe a
Nothing

-- |Emit a compile error if a special command option type is used as a handler parameter after a regular, value
-- parameter.
--
-- The parameter @allowed@ is set to 'False' when the first non-option parameter is encountered.
type family BeforeRegular (allowed :: Bool) (a :: Type) :: Constraint where
  BeforeRegular 'False a =
    TypeError ("Command option type " <> a <> " may not come after non-option") ~ ()
  BeforeRegular 'True _ =
    ()

instance (
    BeforeRegular al (Range rs),
    RangeStyleOpt rs
  ) => SpecialParam ('OptionState al c ac) (Range rs) where
  specialOpt :: Map Text Object
specialOpt =
    forall (s :: RangeStyle). RangeStyleOpt s => Map Text Object
rangeStyleOpt @rs
  specialArg :: Maybe Text
specialArg =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (forall (s :: RangeStyle). RangeStyleOpt s => Text
rangeStyleArg @rs)

instance (
    BeforeRegular al Bang
  ) => SpecialParam ('OptionState al c ac) Bang where
  specialOpt :: Map Text Object
specialOpt =
    [(Text
"bang", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]
  specialArg :: Maybe Text
specialArg =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"'<bang>' == '!'"

instance (
    BeforeRegular al Bar
  ) => SpecialParam ('OptionState al c ac) Bar where
  specialOpt :: Map Text Object
specialOpt =
    [(Text
"bar", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]
  specialArg :: Maybe Text
specialArg =
    Maybe Text
forall a. Maybe a
Nothing

instance (
    BeforeRegular al CommandMods
  ) => SpecialParam ('OptionState al c ac) CommandMods where
  specialOpt :: Map Text Object
specialOpt =
    Map Text Object
forall a. Monoid a => a
mempty
  specialArg :: Maybe Text
specialArg =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"<q-mods>"

instance (
    BeforeRegular al CommandRegister
  ) => SpecialParam ('OptionState al c ac) CommandRegister where
  specialOpt :: Map Text Object
specialOpt =
    [(Text
"register", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]
  specialArg :: Maybe Text
specialArg =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"<q-register>"

instance SpecialParam ('OptionState al count 'Nothing) Args where
  type TransSpecial ('OptionState _ count _) _ =
    'OptionState 'True (Max count 'MinZero) ('Just Args)

instance SpecialParam ('OptionState al count ac) (JsonArgs a) where
  type TransSpecial ('OptionState _ count _) (JsonArgs a) =
    'OptionState 'True (Max count 'MinZero) ('Just (JsonArgs a))

instance SpecialParam ('OptionState al count ac) ArgList where
  type TransSpecial ('OptionState _ count _) _ =
    'OptionState 'True (Max count 'MinZero) ('Just ArgList)

instance SpecialParam ('OptionState al count 'Nothing) (Options a) where
  type TransSpecial ('OptionState _ count _) (Options a) =
    'OptionState 'True (Max count 'MinZero) ('Just (Options a))

-- |Determines whether a regular, value parameter is allowed (it isn't after types like 'ArgList' that consume all
-- remaining arguments), and increases the minimum argument count if the parameter isn't 'Maybe'.
class RegularParam (state :: OptionState) (isMaybe :: Bool) a where
  type TransRegular state isMaybe a :: OptionState

type family ArgsError consumer a where
  ArgsError consumer a =
    TypeError (
      "Custom parameter types (here " <> a <> ") cannot be combined with " <> consumer
      %
      "since " <> consumer <> " consumes all arguments"
    )

instance RegularParam ('OptionState al count ('Just consumer)) m a where
  type TransRegular ('OptionState al count ('Just consumer)) m a =
    ArgsError consumer a

instance RegularParam ('OptionState al count 'Nothing) 'True (Maybe a) where
  type TransRegular ('OptionState al count 'Nothing) 'True (Maybe a) =
    'OptionState 'False (Max count 'MinZero) 'Nothing

instance RegularParam ('OptionState al count 'Nothing) 'False a where
  type TransRegular ('OptionState al count 'Nothing) 'False a =
    'OptionState 'False 'MinOne 'Nothing

-- |Determine the command option and parameter that a handler parameter type requires, if any.
class CommandParam (special :: Bool) (state :: OptionState) (a :: Type) where
  -- |Transition the current 'OptionState'.
  type TransState special state a :: OptionState

  paramOpt :: Map Text Object
  paramOpt =
    Map Text Object
forall a. Monoid a => a
mempty

  paramArg :: Maybe Text
  paramArg =
    Maybe Text
forall a. Maybe a
Nothing

instance (
    SpecialParam state a
  ) => CommandParam 'True state a where
    type TransState 'True state a =
      TransSpecial state a

    paramOpt :: Map Text Object
paramOpt =
      forall (state :: OptionState) a.
SpecialParam state a =>
Map Text Object
specialOpt @state @a

    paramArg :: Maybe Text
paramArg =
      forall (state :: OptionState) a. SpecialParam state a => Maybe Text
specialArg @state @a

type family IsMaybe (a :: Type) :: Bool where
  IsMaybe (Maybe _) = 'True
  IsMaybe _ = 'False

instance (
    RegularParam state (IsMaybe a) a
  ) => CommandParam 'False state a where
    type TransState 'False state a =
      TransRegular state (IsMaybe a) a

-- |Derive the command options and arguments that should be used when registering the Neovim command, from the
-- parameters of the handler function.
--
-- See [Command params]("Ribosome#command-params") for the list of supported special types.
--
-- The parameter @state@ is a type level value that determines which parameter types may be used after another and
-- counts the number of command arguments that are required or allowed.
-- It is transitioned by families in the classes 'CommandParam', 'SpecialParam' and 'RegularParam'.
class CommandHandler (state :: OptionState) (h :: Type) where
  -- |Return the list of command options and special arguments determined by the handler function's parameters.
  commandOptions :: (Map Text Object, [Text])

instance CommandHandler ('OptionState _a 'Zero c) (Sem r a) where
  commandOptions :: (Map Text Object, [Text])
commandOptions =
    ([(Text
"nargs", forall a. MsgpackEncode a => a -> Object
toMsgpack @Int Int
0)], [])

instance CommandHandler ('OptionState _a 'MinZero c) (Sem r a) where
  commandOptions :: (Map Text Object, [Text])
commandOptions =
    ([(Text
"nargs", forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"*")], [Item [Text]
"<f-args>"])

instance CommandHandler ('OptionState _a 'MinOne c) (Sem r a) where
  commandOptions :: (Map Text Object, [Text])
commandOptions =
    ([(Text
"nargs", forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"+")], [Item [Text]
"<f-args>"])

instance (
    special ~ CommandSpecial a,
    next ~ TransState special state a,
    CommandParam special state a,
    CommandHandler next b
  ) => CommandHandler state (a -> b) where
    commandOptions :: (Map Text Object, [Text])
commandOptions =
      (Map Text Object
opts, [Text]
args)
      where
        opts :: Map Text Object
opts =
          forall (special :: Bool) (state :: OptionState) a.
CommandParam special state a =>
Map Text Object
paramOpt @special @state @a Map Text Object -> Map Text Object -> Map Text Object
forall a. Semigroup a => a -> a -> a
<> Map Text Object
optsAfter
        args :: [Text]
args =
          Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (forall (special :: Bool) (state :: OptionState) a.
CommandParam special state a =>
Maybe Text
paramArg @special @state @a) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
argsAfter
        (Map Text Object
optsAfter, [Text]
argsAfter) =
          forall (state :: OptionState) h.
CommandHandler state h =>
(Map Text Object, [Text])
commandOptions @next @b