-- |Codec data type for Neovim register types.
module Ribosome.Data.RegisterType where

import Prettyprinter (Pretty (pretty))

import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode (..))
import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (..))
import Ribosome.Host.Class.Msgpack.Util (decodeString)

-- |The type of a Neovim register, corresponding to concepts like line- or character-wise visual mode.
data RegisterType =
  Character
  |
  Line
  |
  Block
  |
  BlockWidth Int
  |
  Unknown Text
  deriving stock (RegisterType -> RegisterType -> Bool
(RegisterType -> RegisterType -> Bool)
-> (RegisterType -> RegisterType -> Bool) -> Eq RegisterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterType -> RegisterType -> Bool
$c/= :: RegisterType -> RegisterType -> Bool
== :: RegisterType -> RegisterType -> Bool
$c== :: RegisterType -> RegisterType -> Bool
Eq, Int -> RegisterType -> ShowS
[RegisterType] -> ShowS
RegisterType -> String
(Int -> RegisterType -> ShowS)
-> (RegisterType -> String)
-> ([RegisterType] -> ShowS)
-> Show RegisterType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterType] -> ShowS
$cshowList :: [RegisterType] -> ShowS
show :: RegisterType -> String
$cshow :: RegisterType -> String
showsPrec :: Int -> RegisterType -> ShowS
$cshowsPrec :: Int -> RegisterType -> ShowS
Show, Eq RegisterType
Eq RegisterType
-> (RegisterType -> RegisterType -> Ordering)
-> (RegisterType -> RegisterType -> Bool)
-> (RegisterType -> RegisterType -> Bool)
-> (RegisterType -> RegisterType -> Bool)
-> (RegisterType -> RegisterType -> Bool)
-> (RegisterType -> RegisterType -> RegisterType)
-> (RegisterType -> RegisterType -> RegisterType)
-> Ord RegisterType
RegisterType -> RegisterType -> Bool
RegisterType -> RegisterType -> Ordering
RegisterType -> RegisterType -> RegisterType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RegisterType -> RegisterType -> RegisterType
$cmin :: RegisterType -> RegisterType -> RegisterType
max :: RegisterType -> RegisterType -> RegisterType
$cmax :: RegisterType -> RegisterType -> RegisterType
>= :: RegisterType -> RegisterType -> Bool
$c>= :: RegisterType -> RegisterType -> Bool
> :: RegisterType -> RegisterType -> Bool
$c> :: RegisterType -> RegisterType -> Bool
<= :: RegisterType -> RegisterType -> Bool
$c<= :: RegisterType -> RegisterType -> Bool
< :: RegisterType -> RegisterType -> Bool
$c< :: RegisterType -> RegisterType -> Bool
compare :: RegisterType -> RegisterType -> Ordering
$ccompare :: RegisterType -> RegisterType -> Ordering
Ord)

instance IsString RegisterType where
  fromString :: String -> RegisterType
fromString String
"v" =
    RegisterType
Character
  fromString String
"V" =
    RegisterType
Line
  fromString a :: String
a@(Char
'c' : Char
'v' : String
_) =
    Text -> RegisterType
Unknown (String -> Text
forall a. ToText a => a -> Text
toText String
a)
  fromString String
a =
    Text -> RegisterType
Unknown (String -> Text
forall a. ToText a => a -> Text
toText String
a)

instance MsgpackDecode RegisterType where
  fromMsgpack :: Object -> Either DecodeError RegisterType
fromMsgpack =
    Object -> Either DecodeError RegisterType
forall a.
(Typeable a, IsString a) =>
Object -> Either DecodeError a
decodeString

instance MsgpackEncode RegisterType where
  toMsgpack :: RegisterType -> Object
toMsgpack RegisterType
Character =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"v" :: Text)
  toMsgpack RegisterType
Line =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"V" :: Text)
  toMsgpack RegisterType
Block =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"b" :: Text)
  toMsgpack (BlockWidth Int
width) =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"b" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
width :: Text)
  toMsgpack (Unknown Text
_) =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"" :: Text)

instance Pretty RegisterType where
  pretty :: forall ann. RegisterType -> Doc ann
pretty = \case
    RegisterType
Character ->
      Doc ann
"c"
    RegisterType
Line ->
      Doc ann
"v"
    RegisterType
Block ->
      Doc ann
"<c-v>"
    BlockWidth Int
width ->
      Doc ann
"<c-v>" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
width
    Unknown Text
a ->
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
a