-- |Data types for register-related API functions.
module Ribosome.Data.Register where

import Data.Char (isAlpha, isNumber)
import qualified Data.Text as Text
import Exon (exon)
import Prettyprinter (Pretty (pretty))

import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode (..), msgpackFromString)
import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (..))

-- |A Neovim register.
data Register =
  Named Text
  |
  Numbered Text
  |
  Special Text
  |
  Empty
  deriving stock (Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c== :: Register -> Register -> Bool
Eq, Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Register] -> ShowS
$cshowList :: [Register] -> ShowS
show :: Register -> String
$cshow :: Register -> String
showsPrec :: Int -> Register -> ShowS
$cshowsPrec :: Int -> Register -> ShowS
Show, (forall x. Register -> Rep Register x)
-> (forall x. Rep Register x -> Register) -> Generic Register
forall x. Rep Register x -> Register
forall x. Register -> Rep Register x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Register x -> Register
$cfrom :: forall x. Register -> Rep Register x
Generic)

instance IsString Register where
  fromString :: String -> Register
fromString = \case
    String
"" ->
      Register
Empty
    [Item String
a] | Char -> Bool
isAlpha Char
Item String
a ->
      Text -> Register
Named (Char -> Text
Text.singleton Char
Item String
a)
    [Item String
a] | Char -> Bool
isNumber Char
Item String
a ->
      Text -> Register
Numbered (Char -> Text
Text.singleton Char
Item String
a)
    String
a ->
      Text -> Register
Special (String -> Text
forall a. ToText a => a -> Text
toText String
a)

instance MsgpackDecode Register where
  fromMsgpack :: Object -> Either Text Register
fromMsgpack =
    Text -> Object -> Either Text Register
forall a. IsString a => Text -> Object -> Either Text a
msgpackFromString Text
"Register"

instance MsgpackEncode Register where
  toMsgpack :: Register -> Object
toMsgpack (Named Text
a) =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Text
a
  toMsgpack (Numbered Text
a) =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Text
a
  toMsgpack (Special Text
a) =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Text
a
  toMsgpack Register
Empty =
    Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"" :: Text)

-- |Render a register name by prefixing it with @"@.
quoted :: Text -> Text
quoted :: Text -> Text
quoted Text
a =
  [exon|"#{a}|]

-- |Render a register name as is usual for Neovim.
registerRepr :: Register -> Text
registerRepr :: Register -> Text
registerRepr = \case
  Named Text
a ->
    Text -> Text
quoted Text
a
  Numbered Text
a ->
    Text -> Text
quoted Text
a
  Special Text
a ->
    Text -> Text
quoted Text
a
  Register
Empty ->
    Text
""

instance Pretty Register where
  pretty :: forall ann. Register -> Doc ann
pretty = \case
    Register
Empty ->
      Doc ann
"no register"
    Register
a ->
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Register -> Text
registerRepr Register
a)