module Data.BAByNF.ABNF.Model 
    ( Rulelist (..)
    , DefinedAs (..)
    , Rule (..)
    , Rulename (..)
    , Elements (..)
    , Alternation (..)
    , Concatenation (..)
    , Repetition (..)
    , Repeat (..)
    , Bound (..)
    , Element (..)
    , Group (..)
    , Option (..)
    , CharVal (..)
    , CaseInsensitiveString (..)
    , CaseSensitiveString (..)
    , QuotedString (..)
    , NumVal (..)
    , BinVal (..)
    , DecVal (..)
    , HexVal (..)
    , ProseVal (..)
    ) where

import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as ByteString.Char8

import Data.BAByNF.Util.Ascii qualified as Ascii
import Data.BAByNF.Util.Binary qualified as Binary
import Data.BAByNF.Util.Decimal qualified as Decimal
import Data.BAByNF.Util.Hex qualified as Hex

import Data.BAByNF.Core.Ref (Ref)
import Data.BAByNF.Core.Ref qualified as Ref

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

data DefinedAs = BasicDefinition | IncrementalAlternative deriving (DefinedAs -> DefinedAs -> Bool
(DefinedAs -> DefinedAs -> Bool)
-> (DefinedAs -> DefinedAs -> Bool) -> Eq DefinedAs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefinedAs -> DefinedAs -> Bool
== :: DefinedAs -> DefinedAs -> Bool
$c/= :: DefinedAs -> DefinedAs -> Bool
/= :: DefinedAs -> DefinedAs -> Bool
Eq, Int -> DefinedAs -> ShowS
[DefinedAs] -> ShowS
DefinedAs -> String
(Int -> DefinedAs -> ShowS)
-> (DefinedAs -> String)
-> ([DefinedAs] -> ShowS)
-> Show DefinedAs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinedAs -> ShowS
showsPrec :: Int -> DefinedAs -> ShowS
$cshow :: DefinedAs -> String
show :: DefinedAs -> String
$cshowList :: [DefinedAs] -> ShowS
showList :: [DefinedAs] -> ShowS
Show)

data Rule = Rule Rulename DefinedAs Elements deriving (Rule -> Rule -> Bool
(Rule -> Rule -> Bool) -> (Rule -> Rule -> Bool) -> Eq Rule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rule -> Rule -> Bool
== :: Rule -> Rule -> Bool
$c/= :: Rule -> Rule -> Bool
/= :: Rule -> Rule -> Bool
Eq, Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
(Int -> Rule -> ShowS)
-> (Rule -> String) -> ([Rule] -> ShowS) -> Show Rule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rule -> ShowS
showsPrec :: Int -> Rule -> ShowS
$cshow :: Rule -> String
show :: Rule -> String
$cshowList :: [Rule] -> ShowS
showList :: [Rule] -> ShowS
Show)

newtype Rulename = Rulename ByteString deriving Rulename -> Rulename -> Bool
(Rulename -> Rulename -> Bool)
-> (Rulename -> Rulename -> Bool) -> Eq Rulename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rulename -> Rulename -> Bool
== :: Rulename -> Rulename -> Bool
$c/= :: Rulename -> Rulename -> Bool
/= :: Rulename -> Rulename -> Bool
Eq

instance Show Rulename where
  show :: Rulename -> String
show (Rulename ByteString
b) = String
"Rulename[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
ByteString.Char8.unpack ByteString
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]" 

instance Ref Rulename where
  eq :: Rulename -> Rulename -> Bool
eq (Rulename ByteString
x) (Rulename ByteString
y) = ByteString -> ByteString -> Bool
Ascii.eqNoCaseBS ByteString
x ByteString
y
  display :: Rulename -> String
display (Rulename ByteString
x) = ByteString -> String
forall a. Show a => a -> String
show ByteString
x

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

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

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

data Repeat = NoRepeat | FixedRepeat Integer | RangedRepeat Bound Bound deriving (Repeat -> Repeat -> Bool
(Repeat -> Repeat -> Bool)
-> (Repeat -> Repeat -> Bool) -> Eq Repeat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repeat -> Repeat -> Bool
== :: Repeat -> Repeat -> Bool
$c/= :: Repeat -> Repeat -> Bool
/= :: Repeat -> Repeat -> Bool
Eq, Int -> Repeat -> ShowS
[Repeat] -> ShowS
Repeat -> String
(Int -> Repeat -> ShowS)
-> (Repeat -> String) -> ([Repeat] -> ShowS) -> Show Repeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Repeat -> ShowS
showsPrec :: Int -> Repeat -> ShowS
$cshow :: Repeat -> String
show :: Repeat -> String
$cshowList :: [Repeat] -> ShowS
showList :: [Repeat] -> ShowS
Show)
data Bound = UnBound | FixedBound Integer deriving (Bound -> Bound -> Bool
(Bound -> Bound -> Bool) -> (Bound -> Bound -> Bool) -> Eq Bound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bound -> Bound -> Bool
== :: Bound -> Bound -> Bool
$c/= :: Bound -> Bound -> Bool
/= :: Bound -> Bound -> Bool
Eq, Int -> Bound -> ShowS
[Bound] -> ShowS
Bound -> String
(Int -> Bound -> ShowS)
-> (Bound -> String) -> ([Bound] -> ShowS) -> Show Bound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bound -> ShowS
showsPrec :: Int -> Bound -> ShowS
$cshow :: Bound -> String
show :: Bound -> String
$cshowList :: [Bound] -> ShowS
showList :: [Bound] -> ShowS
Show)

data Element = RulenameElement Rulename
             | GroupElement Group
             | OptionElement Option
             | CharValElement CharVal
             | NumValElement NumVal
             | ProseValElement ProseVal
             deriving (Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
/= :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Element -> ShowS
showsPrec :: Int -> Element -> ShowS
$cshow :: Element -> String
show :: Element -> String
$cshowList :: [Element] -> ShowS
showList :: [Element] -> ShowS
Show)


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

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

data CharVal = CaseInsensitiveCharVal CaseInsensitiveString
             | CaseSensitiveCharVal CaseSensitiveString
             deriving (CharVal -> CharVal -> Bool
(CharVal -> CharVal -> Bool)
-> (CharVal -> CharVal -> Bool) -> Eq CharVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CharVal -> CharVal -> Bool
== :: CharVal -> CharVal -> Bool
$c/= :: CharVal -> CharVal -> Bool
/= :: CharVal -> CharVal -> Bool
Eq, Int -> CharVal -> ShowS
[CharVal] -> ShowS
CharVal -> String
(Int -> CharVal -> ShowS)
-> (CharVal -> String) -> ([CharVal] -> ShowS) -> Show CharVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CharVal -> ShowS
showsPrec :: Int -> CharVal -> ShowS
$cshow :: CharVal -> String
show :: CharVal -> String
$cshowList :: [CharVal] -> ShowS
showList :: [CharVal] -> ShowS
Show)

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

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

newtype QuotedString = QuotedString ByteString deriving QuotedString -> QuotedString -> Bool
(QuotedString -> QuotedString -> Bool)
-> (QuotedString -> QuotedString -> Bool) -> Eq QuotedString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuotedString -> QuotedString -> Bool
== :: QuotedString -> QuotedString -> Bool
$c/= :: QuotedString -> QuotedString -> Bool
/= :: QuotedString -> QuotedString -> Bool
Eq

instance Show QuotedString where
  show :: QuotedString -> String
show (QuotedString ByteString
b) = ShowS
forall a. Show a => a -> String
show (ByteString -> String
ByteString.Char8.unpack ByteString
b)

data NumVal = BinNumVal BinVal
            | DecNumVal DecVal
            | HexNumVal HexVal
            deriving (NumVal -> NumVal -> Bool
(NumVal -> NumVal -> Bool)
-> (NumVal -> NumVal -> Bool) -> Eq NumVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumVal -> NumVal -> Bool
== :: NumVal -> NumVal -> Bool
$c/= :: NumVal -> NumVal -> Bool
/= :: NumVal -> NumVal -> Bool
Eq, Int -> NumVal -> ShowS
[NumVal] -> ShowS
NumVal -> String
(Int -> NumVal -> ShowS)
-> (NumVal -> String) -> ([NumVal] -> ShowS) -> Show NumVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumVal -> ShowS
showsPrec :: Int -> NumVal -> ShowS
$cshow :: NumVal -> String
show :: NumVal -> String
$cshowList :: [NumVal] -> ShowS
showList :: [NumVal] -> ShowS
Show)


data BinVal = SeqBinVal [Binary.Seq] | RangeBinVal Binary.Seq Binary.Seq deriving (BinVal -> BinVal -> Bool
(BinVal -> BinVal -> Bool)
-> (BinVal -> BinVal -> Bool) -> Eq BinVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinVal -> BinVal -> Bool
== :: BinVal -> BinVal -> Bool
$c/= :: BinVal -> BinVal -> Bool
/= :: BinVal -> BinVal -> Bool
Eq, Int -> BinVal -> ShowS
[BinVal] -> ShowS
BinVal -> String
(Int -> BinVal -> ShowS)
-> (BinVal -> String) -> ([BinVal] -> ShowS) -> Show BinVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinVal -> ShowS
showsPrec :: Int -> BinVal -> ShowS
$cshow :: BinVal -> String
show :: BinVal -> String
$cshowList :: [BinVal] -> ShowS
showList :: [BinVal] -> ShowS
Show)

data DecVal = SeqDecVal [Decimal.Seq] | RangeDecVal Decimal.Seq Decimal.Seq deriving (DecVal -> DecVal -> Bool
(DecVal -> DecVal -> Bool)
-> (DecVal -> DecVal -> Bool) -> Eq DecVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecVal -> DecVal -> Bool
== :: DecVal -> DecVal -> Bool
$c/= :: DecVal -> DecVal -> Bool
/= :: DecVal -> DecVal -> Bool
Eq, Int -> DecVal -> ShowS
[DecVal] -> ShowS
DecVal -> String
(Int -> DecVal -> ShowS)
-> (DecVal -> String) -> ([DecVal] -> ShowS) -> Show DecVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecVal -> ShowS
showsPrec :: Int -> DecVal -> ShowS
$cshow :: DecVal -> String
show :: DecVal -> String
$cshowList :: [DecVal] -> ShowS
showList :: [DecVal] -> ShowS
Show)

data HexVal = SeqHexVal [Hex.Seq] | RangeHexVal Hex.Seq Hex.Seq deriving (HexVal -> HexVal -> Bool
(HexVal -> HexVal -> Bool)
-> (HexVal -> HexVal -> Bool) -> Eq HexVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HexVal -> HexVal -> Bool
== :: HexVal -> HexVal -> Bool
$c/= :: HexVal -> HexVal -> Bool
/= :: HexVal -> HexVal -> Bool
Eq, Int -> HexVal -> ShowS
[HexVal] -> ShowS
HexVal -> String
(Int -> HexVal -> ShowS)
-> (HexVal -> String) -> ([HexVal] -> ShowS) -> Show HexVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HexVal -> ShowS
showsPrec :: Int -> HexVal -> ShowS
$cshow :: HexVal -> String
show :: HexVal -> String
$cshowList :: [HexVal] -> ShowS
showList :: [HexVal] -> ShowS
Show)

newtype ProseVal = ProseVal ByteString deriving ProseVal -> ProseVal -> Bool
(ProseVal -> ProseVal -> Bool)
-> (ProseVal -> ProseVal -> Bool) -> Eq ProseVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProseVal -> ProseVal -> Bool
== :: ProseVal -> ProseVal -> Bool
$c/= :: ProseVal -> ProseVal -> Bool
/= :: ProseVal -> ProseVal -> Bool
Eq
instance Show ProseVal where
  show :: ProseVal -> String
show (ProseVal ByteString
b) = String
"ProseVal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (ByteString -> String
ByteString.Char8.unpack ByteString
b)