module Ribosome.Data.RegisterType where

import Data.Text.Prettyprint.Doc (Pretty(..))

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

data RegisterType =
  Character
  |
  Line
  |
  Block
  |
  BlockWidth Int
  |
  Unknown Text
  deriving (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)

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 Err RegisterType
fromMsgpack = Text -> Object -> Either Err RegisterType
forall a. IsString a => Text -> Object -> Either Err a
msgpackFromString Text
"RegisterType"

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 :: RegisterType -> Doc ann
pretty RegisterType
Character = Doc ann
"c"
  pretty RegisterType
Line = Doc ann
"v"
  pretty RegisterType
Block = Doc ann
"<c-v>"
  pretty (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
  pretty (Unknown Text
a) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
a