module Rattletrap.Type.RemoteId.Epic where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Utility.Json as Json

newtype Epic
  = Epic Str.Str
  deriving (Epic -> Epic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Epic -> Epic -> Bool
$c/= :: Epic -> Epic -> Bool
== :: Epic -> Epic -> Bool
$c== :: Epic -> Epic -> Bool
Eq, Int -> Epic -> ShowS
[Epic] -> ShowS
Epic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Epic] -> ShowS
$cshowList :: [Epic] -> ShowS
show :: Epic -> String
$cshow :: Epic -> String
showsPrec :: Int -> Epic -> ShowS
$cshowsPrec :: Int -> Epic -> ShowS
Show)

instance Json.FromJSON Epic where
  parseJSON :: Value -> Parser Epic
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Epic
fromStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Epic where
  toJSON :: Epic -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Epic -> Str
toStr

fromStr :: Str.Str -> Epic
fromStr :: Str -> Epic
fromStr = Str -> Epic
Epic

toStr :: Epic -> Str.Str
toStr :: Epic -> Str
toStr (Epic Str
x) = Str
x

schema :: Schema.Schema
schema :: Schema
schema = Schema
Str.schema

bitPut :: Epic -> BitPut.BitPut
bitPut :: Epic -> BitPut
bitPut = Str -> BitPut
Str.bitPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Epic -> Str
toStr

bitGet :: BitGet.BitGet Epic
bitGet :: BitGet Epic
bitGet = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Epic" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Epic
fromStr BitGet Str
Str.bitGet