module Codec.CBOR.Cuddle.CDDL.Postlude where

import Data.Hashable (Hashable)
import GHC.Generics (Generic)

-- |
--
--  CDDL predefines a number of names.  This subsection summarizes these
--  names, but please see Appendix D for the exact definitions.
--
--  The following keywords for primitive datatypes are defined:
--
--  "bool"  Boolean value (major type 7, additional information 20
--    or 21).
--
--  "uint"  An unsigned integer (major type 0).
--
--  "nint"  A negative integer (major type 1).
--
--  "int"  An unsigned integer or a negative integer.
--
--  "float16"  A number representable as a half-precision float [IEEE754]
--    (major type 7, additional information 25).
--
--  "float32"  A number representable as a single-precision float
--    [IEEE754] (major type 7, additional information 26).
--
--
--  "float64"  A number representable as a double-precision float
--    [IEEE754] (major type 7, additional information 27).
--
--  "float"  One of float16, float32, or float64.
--
--  "bstr" or "bytes"  A byte string (major type 2).
--
--  "tstr" or "text"  Text string (major type 3).
--
--  (Note that there are no predefined names for arrays or maps; these
--  are defined with the syntax given below.)
data PTerm
  = PTBool
  | PTUInt
  | PTNInt
  | PTInt
  | PTHalf
  | PTFloat
  | PTDouble
  | PTBytes
  | PTText
  | PTAny
  | PTNil
  | PTUndefined
  deriving (PTerm -> PTerm -> Bool
(PTerm -> PTerm -> Bool) -> (PTerm -> PTerm -> Bool) -> Eq PTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PTerm -> PTerm -> Bool
== :: PTerm -> PTerm -> Bool
$c/= :: PTerm -> PTerm -> Bool
/= :: PTerm -> PTerm -> Bool
Eq, (forall x. PTerm -> Rep PTerm x)
-> (forall x. Rep PTerm x -> PTerm) -> Generic PTerm
forall x. Rep PTerm x -> PTerm
forall x. PTerm -> Rep PTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PTerm -> Rep PTerm x
from :: forall x. PTerm -> Rep PTerm x
$cto :: forall x. Rep PTerm x -> PTerm
to :: forall x. Rep PTerm x -> PTerm
Generic, Eq PTerm
Eq PTerm =>
(PTerm -> PTerm -> Ordering)
-> (PTerm -> PTerm -> Bool)
-> (PTerm -> PTerm -> Bool)
-> (PTerm -> PTerm -> Bool)
-> (PTerm -> PTerm -> Bool)
-> (PTerm -> PTerm -> PTerm)
-> (PTerm -> PTerm -> PTerm)
-> Ord PTerm
PTerm -> PTerm -> Bool
PTerm -> PTerm -> Ordering
PTerm -> PTerm -> PTerm
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PTerm -> PTerm -> Ordering
compare :: PTerm -> PTerm -> Ordering
$c< :: PTerm -> PTerm -> Bool
< :: PTerm -> PTerm -> Bool
$c<= :: PTerm -> PTerm -> Bool
<= :: PTerm -> PTerm -> Bool
$c> :: PTerm -> PTerm -> Bool
> :: PTerm -> PTerm -> Bool
$c>= :: PTerm -> PTerm -> Bool
>= :: PTerm -> PTerm -> Bool
$cmax :: PTerm -> PTerm -> PTerm
max :: PTerm -> PTerm -> PTerm
$cmin :: PTerm -> PTerm -> PTerm
min :: PTerm -> PTerm -> PTerm
Ord, Int -> PTerm -> ShowS
[PTerm] -> ShowS
PTerm -> String
(Int -> PTerm -> ShowS)
-> (PTerm -> String) -> ([PTerm] -> ShowS) -> Show PTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PTerm -> ShowS
showsPrec :: Int -> PTerm -> ShowS
$cshow :: PTerm -> String
show :: PTerm -> String
$cshowList :: [PTerm] -> ShowS
showList :: [PTerm] -> ShowS
Show)

instance Hashable PTerm