{-# options_haddock prune #-}

-- |Special command parameter that governs the range modifier.
module Ribosome.Host.Data.Range where

import Data.MessagePack (Object (ObjectArray))
import Exon (exon)

import Ribosome.Host.Class.Msgpack.Decode (pattern Msgpack, MsgpackDecode (fromMsgpack))
import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)

-- |Neovim offers different semantics for the command range (see @:help :command-range@).
--
-- This type determines the position (prefix line number/postfix count) and default values.
data RangeStyle =
  -- |Prefix line range, defaulting to the entire file (@-range=%@).
  RangeFile
  |
  -- |'Nothing': Prefix line range defaulting to the current line (@-range@).
  -- |@'Just' N@: Prefix count defaulting to @N@ (@-range=N@).
  RangeLine (Maybe Nat)
  |
  -- |@'Just' N@: Prefix or postfix count defaulting to @N@ (@-count=N@).
  -- |'Nothing': Same as @'Just' 0@ (@-count@).
  RangeCount (Maybe Nat)

-- |When this type is used as a parameter of a command handler function, the command is declared with the @-range@
-- option, and when invoked, the argument passed to the handler contains the line range specified by the user, as in:
--
-- > :5Reverse
-- > :5,20Reverse
--
-- In the first case, the field 'high' is 'Nothing'.
--
-- The type has a phantom parameter of kind 'RangeStyle' that configures the semantics of the range, as defined by
-- Neovim (see @:help :command-range@).
data Range (style :: RangeStyle) =
  Range {
    forall (style :: RangeStyle). Range style -> Int64
low :: Int64,
    forall (style :: RangeStyle). Range style -> Maybe Int64
high :: Maybe Int64
  }
  deriving stock (Range style -> Range style -> Bool
(Range style -> Range style -> Bool)
-> (Range style -> Range style -> Bool) -> Eq (Range style)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (style :: RangeStyle). Range style -> Range style -> Bool
/= :: Range style -> Range style -> Bool
$c/= :: forall (style :: RangeStyle). Range style -> Range style -> Bool
== :: Range style -> Range style -> Bool
$c== :: forall (style :: RangeStyle). Range style -> Range style -> Bool
Eq, Int -> Range style -> ShowS
[Range style] -> ShowS
Range style -> String
(Int -> Range style -> ShowS)
-> (Range style -> String)
-> ([Range style] -> ShowS)
-> Show (Range style)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (style :: RangeStyle). Int -> Range style -> ShowS
forall (style :: RangeStyle). [Range style] -> ShowS
forall (style :: RangeStyle). Range style -> String
showList :: [Range style] -> ShowS
$cshowList :: forall (style :: RangeStyle). [Range style] -> ShowS
show :: Range style -> String
$cshow :: forall (style :: RangeStyle). Range style -> String
showsPrec :: Int -> Range style -> ShowS
$cshowsPrec :: forall (style :: RangeStyle). Int -> Range style -> ShowS
Show)

instance MsgpackDecode (Range style) where
  fromMsgpack :: Object -> Either Text (Range style)
fromMsgpack = \case
    ObjectArray [Msgpack Int64
low, Msgpack Int64
high] ->
      Range style -> Either Text (Range style)
forall a b. b -> Either a b
Right (Int64 -> Maybe Int64 -> Range style
forall (style :: RangeStyle). Int64 -> Maybe Int64 -> Range style
Range Int64
low (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
high))
    ObjectArray [Msgpack Int64
low] ->
      Range style -> Either Text (Range style)
forall a b. b -> Either a b
Right (Int64 -> Maybe Int64 -> Range style
forall (style :: RangeStyle). Int64 -> Maybe Int64 -> Range style
Range Int64
low Maybe Int64
forall a. Maybe a
Nothing)
    Object
o ->
      Text -> Either Text (Range style)
forall a b. a -> Either a b
Left [exon|Range must be an array with one or two elements: #{show o}|]

class RangeStyleOpt (s :: RangeStyle) where
  rangeStyleOpt :: Map Text Object

  rangeStyleArg :: Text
  rangeStyleArg =
    Text
"[<line1>, <line2>]"

instance RangeStyleOpt ('RangeLine 'Nothing) where
  rangeStyleOpt :: Map Text Object
rangeStyleOpt =
    [(Text
"range", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]

instance RangeStyleOpt 'RangeFile where
  rangeStyleOpt :: Map Text Object
rangeStyleOpt =
    [(Text
"range", forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"%")]

instance (
    KnownNat n
  ) => RangeStyleOpt ('RangeLine ('Just n)) where
  rangeStyleOpt :: Map Text Object
rangeStyleOpt =
    [(Text
"range", Integer -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)))]

  rangeStyleArg :: Text
rangeStyleArg =
    Text
"[<count>]"

instance RangeStyleOpt ('RangeCount 'Nothing) where
  rangeStyleOpt :: Map Text Object
rangeStyleOpt =
    [(Text
"count", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]

  rangeStyleArg :: Text
rangeStyleArg =
    Text
"[<count>]"

instance (
    KnownNat n
  ) => RangeStyleOpt ('RangeCount ('Just n)) where
  rangeStyleOpt :: Map Text Object
rangeStyleOpt =
    [(Text
"count", Integer -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)))]

  rangeStyleArg :: Text
rangeStyleArg =
    Text
"[<count>]"