module Ribosome.Data.Register where

import Data.Char (isAlpha, isNumber)
import qualified Data.Text as Text (singleton)
import Data.Text.Prettyprint.Doc (Doc, Pretty(..))

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

data Register =
  Named Text
  |
  Numbered Text
  |
  Special Text
  |
  Empty
  deriving (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 String
"" =
    Register
Empty
  fromString [Item String
a] | Char -> Bool
isAlpha Char
Item String
a =
    Text -> Register
Named (Text -> Register) -> Text -> Register
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
Item String
a
  fromString [Item String
a] | Char -> Bool
isNumber Char
Item String
a =
    Text -> Register
Numbered (Text -> Register) -> Text -> Register
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
Item String
a
  fromString String
a =
    Text -> Register
Special (Text -> Register) -> Text -> Register
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
a

instance MsgpackDecode Register where
  fromMsgpack :: Object -> Either Err Register
fromMsgpack = Text -> Object -> Either Err Register
forall a. IsString a => Text -> Object -> Either Err 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)

prettyRegister :: Text -> Doc a
prettyRegister :: Text -> Doc a
prettyRegister Text
a =
  Doc a
"\"" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty Text
a

instance Pretty Register where
  pretty :: Register -> Doc ann
pretty (Named Text
a) = Text -> Doc ann
forall a. Text -> Doc a
prettyRegister Text
a
  pretty (Numbered Text
a) = Text -> Doc ann
forall a. Text -> Doc a
prettyRegister (Text -> Text
forall b a. (Show a, IsString b) => a -> b
show Text
a)
  pretty (Special Text
a) = Text -> Doc ann
forall a. Text -> Doc a
prettyRegister Text
a
  pretty Register
Empty = Doc ann
"no register"

registerRepr :: Register -> Text
registerRepr :: Register -> Text
registerRepr (Named Text
a) =
  Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
registerRepr (Numbered Text
a) =
  Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
registerRepr (Special Text
a) =
  Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
registerRepr Register
Empty =
  Text
""