{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module defined the data structure of CDDL as specified in
--   https://datatracker.ietf.org/doc/rfc8610/
module Codec.CBOR.Cuddle.CDDL (
  CDDL (..),
  sortCDDL,
  cddlTopLevel,
  fromRule,
  fromRules,
  appendRules,
  TopLevel (..),
  Name (..),
  Rule (..),
  TypeOrGroup (..),
  Assign (..),
  GenericArg (..),
  GenericParameters (..),
  GenericParameter (..),
  Type0 (..),
  Type1 (..),
  Type2 (..),
  TyOp (..),
  RangeBound (..),
  OccurrenceIndicator (..),
  Group (..),
  GroupEntry (..),
  GroupEntryVariant (..),
  MemberKey (..),
  Value (..),
  value,
  ValueVariant (..),
  GrpChoice (..),
  unwrap,
  compareRuleName,
  HasName (..),
  -- Extension
  ForAllExtensions,
  XCddl,
  XTerm,
  XRule,
  XXTopLevel,
  XXType2,
) where

import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment, HasComment (..))
import Data.ByteString qualified as B
import Data.Default.Class (Default (..))
import Data.Function (on)
import Data.Hashable (Hashable)
import Data.List.NonEmpty (NonEmpty (..), prependList)
import Data.List.NonEmpty qualified as NE
import Data.Maybe (mapMaybe)
import Data.String (IsString (..))
import Data.Text qualified as T
import Data.TreeDiff (ToExpr)
import Data.Word (Word64, Word8)
import GHC.Base (Constraint, Type)
import GHC.Generics (Generic)
import Optics.Core ((%), (%~), (&))

data family XXTopLevel i

data family XCddl i

data family XTerm i

data family XRule i

data family XXType2 i

type ForAllExtensions i (c :: Type -> Constraint) =
  ( c (XCddl i)
  , c (XTerm i)
  , c (XRule i)
  , c (XXTopLevel i)
  , c (XXType2 i)
  )

-- | The CDDL constructor takes three arguments:
--     1. Top level comments that precede the first definition
--     2. The root definition
--     3. All the other top level comments and definitions
--   This ensures that `CDDL` is correct by construction.
data CDDL i = CDDL
  { forall i. CDDL i -> Rule i
rootDefinition :: Rule i
  , forall i. CDDL i -> [TopLevel i]
topLevelDefinitions :: [TopLevel i]
  , forall i. CDDL i -> [XXTopLevel i]
cddlExt :: [XXTopLevel i]
  -- ^ This extension is used for comments that appear before the root definition
  }
  deriving ((forall x. CDDL i -> Rep (CDDL i) x)
-> (forall x. Rep (CDDL i) x -> CDDL i) -> Generic (CDDL i)
forall x. Rep (CDDL i) x -> CDDL i
forall x. CDDL i -> Rep (CDDL i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (CDDL i) x -> CDDL i
forall i x. CDDL i -> Rep (CDDL i) x
$cfrom :: forall i x. CDDL i -> Rep (CDDL i) x
from :: forall x. CDDL i -> Rep (CDDL i) x
$cto :: forall i x. Rep (CDDL i) x -> CDDL i
to :: forall x. Rep (CDDL i) x -> CDDL i
Generic)

deriving instance ForAllExtensions i Eq => Eq (CDDL i)

deriving instance ForAllExtensions i Show => Show (CDDL i)

deriving instance ForAllExtensions i ToExpr => ToExpr (CDDL i)

ruleTopLevel :: TopLevel i -> Maybe (Rule i)
ruleTopLevel :: forall i. TopLevel i -> Maybe (Rule i)
ruleTopLevel (TopLevelRule Rule i
r) = Rule i -> Maybe (Rule i)
forall a. a -> Maybe a
Just Rule i
r
ruleTopLevel TopLevel i
_ = Maybe (Rule i)
forall a. Maybe a
Nothing

-- | Sort the CDDL Rules on the basis of their names
sortCDDL :: CDDL i -> NonEmpty (Rule i)
sortCDDL :: forall i. CDDL i -> NonEmpty (Rule i)
sortCDDL (CDDL Rule i
r [TopLevel i]
rs [XXTopLevel i]
_) = (Rule i -> Rule i -> Ordering)
-> NonEmpty (Rule i) -> NonEmpty (Rule i)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (Rule i -> Text) -> Rule i -> Rule i -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> Text
unName (Name -> Text) -> (Rule i -> Name) -> Rule i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule i -> Name
forall i. Rule i -> Name
ruleName) (NonEmpty (Rule i) -> NonEmpty (Rule i))
-> NonEmpty (Rule i) -> NonEmpty (Rule i)
forall a b. (a -> b) -> a -> b
$ Rule i
r Rule i -> [Rule i] -> NonEmpty (Rule i)
forall a. a -> [a] -> NonEmpty a
:| (TopLevel i -> Maybe (Rule i)) -> [TopLevel i] -> [Rule i]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TopLevel i -> Maybe (Rule i)
forall i. TopLevel i -> Maybe (Rule i)
ruleTopLevel [TopLevel i]
rs

fromRules :: Monoid (XCddl i) => NonEmpty (Rule i) -> CDDL i
fromRules :: forall i. Monoid (XCddl i) => NonEmpty (Rule i) -> CDDL i
fromRules (Rule i
x :| [Rule i]
xs) = Rule i -> [TopLevel i] -> [XXTopLevel i] -> CDDL i
forall i. Rule i -> [TopLevel i] -> [XXTopLevel i] -> CDDL i
CDDL Rule i
x (Rule i -> TopLevel i
forall i. Rule i -> TopLevel i
TopLevelRule (Rule i -> TopLevel i) -> [Rule i] -> [TopLevel i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule i]
xs) [XXTopLevel i]
forall a. Monoid a => a
mempty

fromRule :: Monoid (XCddl i) => Rule i -> CDDL i
fromRule :: forall i. Monoid (XCddl i) => Rule i -> CDDL i
fromRule Rule i
x = Rule i -> [TopLevel i] -> [XXTopLevel i] -> CDDL i
forall i. Rule i -> [TopLevel i] -> [XXTopLevel i] -> CDDL i
CDDL Rule i
x [] [XXTopLevel i]
forall a. Monoid a => a
mempty

appendRules :: CDDL i -> [Rule i] -> CDDL i
appendRules :: forall i. CDDL i -> [Rule i] -> CDDL i
appendRules CDDL i
cddl [Rule i]
rs = CDDL i
cddl CDDL i -> (CDDL i -> CDDL i) -> CDDL i
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx (CDDL i) (CDDL i) [TopLevel i] [TopLevel i]
#topLevelDefinitions Optic A_Lens NoIx (CDDL i) (CDDL i) [TopLevel i] [TopLevel i]
-> ([TopLevel i] -> [TopLevel i]) -> CDDL i -> CDDL i
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ([TopLevel i] -> [TopLevel i] -> [TopLevel i]
forall a. Semigroup a => a -> a -> a
<> (Rule i -> TopLevel i) -> [Rule i] -> [TopLevel i]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rule i -> TopLevel i
forall i. Rule i -> TopLevel i
TopLevelRule [Rule i]
rs)

cddlTopLevel :: CDDL i -> NonEmpty (TopLevel i)
cddlTopLevel :: forall i. CDDL i -> NonEmpty (TopLevel i)
cddlTopLevel (CDDL Rule i
r [TopLevel i]
tls [XXTopLevel i]
e) = [TopLevel i] -> NonEmpty (TopLevel i) -> NonEmpty (TopLevel i)
forall a. [a] -> NonEmpty a -> NonEmpty a
prependList (XXTopLevel i -> TopLevel i
forall i. XXTopLevel i -> TopLevel i
XXTopLevel (XXTopLevel i -> TopLevel i) -> [XXTopLevel i] -> [TopLevel i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XXTopLevel i]
e) (NonEmpty (TopLevel i) -> NonEmpty (TopLevel i))
-> NonEmpty (TopLevel i) -> NonEmpty (TopLevel i)
forall a b. (a -> b) -> a -> b
$ Rule i -> TopLevel i
forall i. Rule i -> TopLevel i
TopLevelRule Rule i
r TopLevel i -> [TopLevel i] -> NonEmpty (TopLevel i)
forall a. a -> [a] -> NonEmpty a
:| [TopLevel i]
tls

data TopLevel i
  = TopLevelRule (Rule i)
  | XXTopLevel (XXTopLevel i)
  deriving ((forall x. TopLevel i -> Rep (TopLevel i) x)
-> (forall x. Rep (TopLevel i) x -> TopLevel i)
-> Generic (TopLevel i)
forall x. Rep (TopLevel i) x -> TopLevel i
forall x. TopLevel i -> Rep (TopLevel i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (TopLevel i) x -> TopLevel i
forall i x. TopLevel i -> Rep (TopLevel i) x
$cfrom :: forall i x. TopLevel i -> Rep (TopLevel i) x
from :: forall x. TopLevel i -> Rep (TopLevel i) x
$cto :: forall i x. Rep (TopLevel i) x -> TopLevel i
to :: forall x. Rep (TopLevel i) x -> TopLevel i
Generic)

deriving instance ForAllExtensions i Eq => Eq (TopLevel i)

deriving instance ForAllExtensions i Show => Show (TopLevel i)

deriving instance ForAllExtensions i ToExpr => ToExpr (TopLevel i)

-- |
--  A name can consist of any of the characters from the set {"A" to
--  "Z", "a" to "z", "0" to "9", "_", "-", "@", ".", "$"}, starting
--  with an alphabetic character (including "@", "_", "$") and ending
--  in such a character or a digit.
--
--  *  Names are case sensitive.
--
--  *  It is preferred style to start a name with a lowercase letter.
--
--  *  The hyphen is preferred over the underscore (except in a
--      "bareword" (Section 3.5.1), where the semantics may actually
--      require an underscore).
--
--  *  The period may be useful for larger specifications, to express
--      some module structure (as in "tcp.throughput" vs.
--      "udp.throughput").
--
--  *  A number of names are predefined in the CDDL prelude, as listed
--      in Appendix D.
--
--  *  Rule names (types or groups) do not appear in the actual CBOR
--      encoding, but names used as "barewords" in member keys do.
newtype Name = Name {Name -> Text
unName :: T.Text}
  deriving ((forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Name -> Rep Name x
from :: forall x. Name -> Rep Name x
$cto :: forall x. Rep Name x -> Name
to :: forall x. Rep Name x -> Name
Generic)
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show)
  deriving newtype (NonEmpty Name -> Name
Name -> Name -> Name
(Name -> Name -> Name)
-> (NonEmpty Name -> Name)
-> (forall b. Integral b => b -> Name -> Name)
-> Semigroup Name
forall b. Integral b => b -> Name -> Name
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Name -> Name -> Name
<> :: Name -> Name -> Name
$csconcat :: NonEmpty Name -> Name
sconcat :: NonEmpty Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
stimes :: forall b. Integral b => b -> Name -> Name
Semigroup, Semigroup Name
Name
Semigroup Name =>
Name -> (Name -> Name -> Name) -> ([Name] -> Name) -> Monoid Name
[Name] -> Name
Name -> Name -> Name
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Name
mempty :: Name
$cmappend :: Name -> Name -> Name
mappend :: Name -> Name -> Name
$cmconcat :: [Name] -> Name
mconcat :: [Name] -> Name
Monoid)

deriving anyclass instance ToExpr Name

instance IsString Name where
  fromString :: String -> Name
fromString = Text -> Name
Name (Text -> Name) -> (String -> Text) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance CollectComments Name where
  collectComments :: Name -> [Comment]
collectComments Name
_ = []

instance Hashable Name

class HasName a where
  getName :: a -> Name

instance HasName Name where
  getName :: Name -> Name
getName = Name -> Name
forall a. a -> a
id

-- |
--   assignt = "=" / "/="
--   assigng = "=" / "//="
--
--   A plain equals sign defines the rule name as the equivalent of the
--   expression to the right; it is an error if the name was already
--   defined with a different expression.  A "/=" or "//=" extends a named
--   type or a group by additional choices; a number of these could be
--   replaced by collecting all the right-hand sides and creating a single
--   rule with a type choice or a group choice built from the right-hand
--   sides in the order of the rules given.  (It is not an error to extend
--   a rule name that has not yet been defined; this makes the right-hand
--   side the first entry in the choice being created.)
data Assign = AssignEq | AssignExt
  deriving (Assign -> Assign -> Bool
(Assign -> Assign -> Bool)
-> (Assign -> Assign -> Bool) -> Eq Assign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Assign -> Assign -> Bool
== :: Assign -> Assign -> Bool
$c/= :: Assign -> Assign -> Bool
/= :: Assign -> Assign -> Bool
Eq, (forall x. Assign -> Rep Assign x)
-> (forall x. Rep Assign x -> Assign) -> Generic Assign
forall x. Rep Assign x -> Assign
forall x. Assign -> Rep Assign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Assign -> Rep Assign x
from :: forall x. Assign -> Rep Assign x
$cto :: forall x. Rep Assign x -> Assign
to :: forall x. Rep Assign x -> Assign
Generic, Int -> Assign -> ShowS
[Assign] -> ShowS
Assign -> String
(Int -> Assign -> ShowS)
-> (Assign -> String) -> ([Assign] -> ShowS) -> Show Assign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Assign -> ShowS
showsPrec :: Int -> Assign -> ShowS
$cshow :: Assign -> String
show :: Assign -> String
$cshowList :: [Assign] -> ShowS
showList :: [Assign] -> ShowS
Show)
  deriving anyclass ([Assign] -> Expr
Assign -> Expr
(Assign -> Expr) -> ([Assign] -> Expr) -> ToExpr Assign
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: Assign -> Expr
toExpr :: Assign -> Expr
$clistToExpr :: [Assign] -> Expr
listToExpr :: [Assign] -> Expr
ToExpr)

-- |
--  Generics
--
--   Using angle brackets, the left-hand side of a rule can add formal
--   parameters after the name being defined, as in:
--
--      messages = message<"reboot", "now"> / message<"sleep", 1..100>
--      message<t, v> = {type: t, value: v}
--
--   When using a generic rule, the formal parameters are bound to the
--   actual arguments supplied (also using angle brackets), within the
--   scope of the generic rule (as if there were a rule of the form
--   parameter = argument).
--
--   Generic rules can be used for establishing names for both types and
--   groups.
newtype GenericParameters i = GenericParameters (NE.NonEmpty (GenericParameter i))
  deriving ((forall x. GenericParameters i -> Rep (GenericParameters i) x)
-> (forall x. Rep (GenericParameters i) x -> GenericParameters i)
-> Generic (GenericParameters i)
forall x. Rep (GenericParameters i) x -> GenericParameters i
forall x. GenericParameters i -> Rep (GenericParameters i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (GenericParameters i) x -> GenericParameters i
forall i x. GenericParameters i -> Rep (GenericParameters i) x
$cfrom :: forall i x. GenericParameters i -> Rep (GenericParameters i) x
from :: forall x. GenericParameters i -> Rep (GenericParameters i) x
$cto :: forall i x. Rep (GenericParameters i) x -> GenericParameters i
to :: forall x. Rep (GenericParameters i) x -> GenericParameters i
Generic)
  deriving newtype (NonEmpty (GenericParameters i) -> GenericParameters i
GenericParameters i -> GenericParameters i -> GenericParameters i
(GenericParameters i -> GenericParameters i -> GenericParameters i)
-> (NonEmpty (GenericParameters i) -> GenericParameters i)
-> (forall b.
    Integral b =>
    b -> GenericParameters i -> GenericParameters i)
-> Semigroup (GenericParameters i)
forall b.
Integral b =>
b -> GenericParameters i -> GenericParameters i
forall i. NonEmpty (GenericParameters i) -> GenericParameters i
forall i.
GenericParameters i -> GenericParameters i -> GenericParameters i
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall i b.
Integral b =>
b -> GenericParameters i -> GenericParameters i
$c<> :: forall i.
GenericParameters i -> GenericParameters i -> GenericParameters i
<> :: GenericParameters i -> GenericParameters i -> GenericParameters i
$csconcat :: forall i. NonEmpty (GenericParameters i) -> GenericParameters i
sconcat :: NonEmpty (GenericParameters i) -> GenericParameters i
$cstimes :: forall i b.
Integral b =>
b -> GenericParameters i -> GenericParameters i
stimes :: forall b.
Integral b =>
b -> GenericParameters i -> GenericParameters i
Semigroup)

deriving instance Eq (XTerm i) => Eq (GenericParameters i)

deriving instance Show (XTerm i) => Show (GenericParameters i)

deriving anyclass instance ToExpr (XTerm i) => ToExpr (GenericParameters i)

data GenericParameter i = GenericParameter
  { forall i. GenericParameter i -> Name
gpName :: Name
  , forall i. GenericParameter i -> XTerm i
gpExt :: XTerm i
  }
  deriving ((forall x. GenericParameter i -> Rep (GenericParameter i) x)
-> (forall x. Rep (GenericParameter i) x -> GenericParameter i)
-> Generic (GenericParameter i)
forall x. Rep (GenericParameter i) x -> GenericParameter i
forall x. GenericParameter i -> Rep (GenericParameter i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (GenericParameter i) x -> GenericParameter i
forall i x. GenericParameter i -> Rep (GenericParameter i) x
$cfrom :: forall i x. GenericParameter i -> Rep (GenericParameter i) x
from :: forall x. GenericParameter i -> Rep (GenericParameter i) x
$cto :: forall i x. Rep (GenericParameter i) x -> GenericParameter i
to :: forall x. Rep (GenericParameter i) x -> GenericParameter i
Generic)

deriving instance Eq (XTerm i) => Eq (GenericParameter i)

deriving instance Show (XTerm i) => Show (GenericParameter i)

deriving anyclass instance ToExpr (XTerm i) => ToExpr (GenericParameter i)

instance CollectComments (XTerm i) => CollectComments (GenericParameter i)

instance HasComment (XTerm i) => HasComment (GenericParameter i) where
  commentL :: Lens' (GenericParameter i) Comment
commentL = Optic
  A_Lens
  NoIx
  (GenericParameter i)
  (GenericParameter i)
  (XTerm i)
  (XTerm i)
#gpExt Optic
  A_Lens
  NoIx
  (GenericParameter i)
  (GenericParameter i)
  (XTerm i)
  (XTerm i)
-> Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
-> Lens' (GenericParameter i) Comment
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
forall a. HasComment a => Lens' a Comment
commentL

newtype GenericArg i = GenericArg (NE.NonEmpty (Type1 i))
  deriving ((forall x. GenericArg i -> Rep (GenericArg i) x)
-> (forall x. Rep (GenericArg i) x -> GenericArg i)
-> Generic (GenericArg i)
forall x. Rep (GenericArg i) x -> GenericArg i
forall x. GenericArg i -> Rep (GenericArg i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (GenericArg i) x -> GenericArg i
forall i x. GenericArg i -> Rep (GenericArg i) x
$cfrom :: forall i x. GenericArg i -> Rep (GenericArg i) x
from :: forall x. GenericArg i -> Rep (GenericArg i) x
$cto :: forall i x. Rep (GenericArg i) x -> GenericArg i
to :: forall x. Rep (GenericArg i) x -> GenericArg i
Generic)
  deriving newtype (NonEmpty (GenericArg i) -> GenericArg i
GenericArg i -> GenericArg i -> GenericArg i
(GenericArg i -> GenericArg i -> GenericArg i)
-> (NonEmpty (GenericArg i) -> GenericArg i)
-> (forall b. Integral b => b -> GenericArg i -> GenericArg i)
-> Semigroup (GenericArg i)
forall b. Integral b => b -> GenericArg i -> GenericArg i
forall i. NonEmpty (GenericArg i) -> GenericArg i
forall i. GenericArg i -> GenericArg i -> GenericArg i
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall i b. Integral b => b -> GenericArg i -> GenericArg i
$c<> :: forall i. GenericArg i -> GenericArg i -> GenericArg i
<> :: GenericArg i -> GenericArg i -> GenericArg i
$csconcat :: forall i. NonEmpty (GenericArg i) -> GenericArg i
sconcat :: NonEmpty (GenericArg i) -> GenericArg i
$cstimes :: forall i b. Integral b => b -> GenericArg i -> GenericArg i
stimes :: forall b. Integral b => b -> GenericArg i -> GenericArg i
Semigroup)

deriving instance ForAllExtensions i Eq => Eq (GenericArg i)

deriving instance ForAllExtensions i Show => Show (GenericArg i)

deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (GenericArg i)

instance ForAllExtensions i CollectComments => CollectComments (GenericArg i)

-- |
--  rule = typename [genericparm] S assignt S type
--        / groupname [genericparm] S assigng S grpent
--
--   typename = id
--   groupname = id
--
--   A rule defines a name for a type expression (production "type") or
--   for a group expression (production "grpent"), with the intention that
--   the semantics does not change when the name is replaced by its
--   (parenthesized if needed) definition.  Note that whether the name
--   defined by a rule stands for a type or a group isn't always
--   determined by syntax alone: e.g., "a = b" can make "a" a type if "b"
--   is a type, or a group if "b" is a group.  More subtly, in "a = (b)",
--   "a" may be used as a type if "b" is a type, or as a group both when
--   "b" is a group and when "b" is a type (a good convention to make the
--   latter case stand out to the human reader is to write "a = (b,)").
--   (Note that the same dual meaning of parentheses applies within an
--   expression but often can be resolved by the context of the
--   parenthesized expression.  On the more general point, it may not be
--   clear immediately either whether "b" stands for a group or a type --
--   this semantic processing may need to span several levels of rule
--   definitions before a determination can be made.)
data Rule i = Rule
  { forall i. Rule i -> Name
ruleName :: Name
  , forall i. Rule i -> Maybe (GenericParameters i)
ruleGenParam :: Maybe (GenericParameters i)
  , forall i. Rule i -> Assign
ruleAssign :: Assign
  , forall i. Rule i -> TypeOrGroup i
ruleTerm :: TypeOrGroup i
  , forall i. Rule i -> XRule i
ruleExt :: XRule i
  }
  deriving ((forall x. Rule i -> Rep (Rule i) x)
-> (forall x. Rep (Rule i) x -> Rule i) -> Generic (Rule i)
forall x. Rep (Rule i) x -> Rule i
forall x. Rule i -> Rep (Rule i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Rule i) x -> Rule i
forall i x. Rule i -> Rep (Rule i) x
$cfrom :: forall i x. Rule i -> Rep (Rule i) x
from :: forall x. Rule i -> Rep (Rule i) x
$cto :: forall i x. Rep (Rule i) x -> Rule i
to :: forall x. Rep (Rule i) x -> Rule i
Generic)

deriving instance ForAllExtensions i Eq => Eq (Rule i)

deriving instance ForAllExtensions i Show => Show (Rule i)

deriving instance ForAllExtensions i ToExpr => ToExpr (Rule i)

instance HasComment (XRule i) => HasComment (Rule i) where
  commentL :: Lens' (Rule i) Comment
commentL = Optic A_Lens NoIx (Rule i) (Rule i) (XRule i) (XRule i)
#ruleExt Optic A_Lens NoIx (Rule i) (Rule i) (XRule i) (XRule i)
-> Optic A_Lens NoIx (XRule i) (XRule i) Comment Comment
-> Lens' (Rule i) Comment
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (XRule i) (XRule i) Comment Comment
forall a. HasComment a => Lens' a Comment
commentL

compareRuleName :: Ord (XTerm i) => Rule i -> Rule i -> Ordering
compareRuleName :: forall i. Ord (XTerm i) => Rule i -> Rule i -> Ordering
compareRuleName = Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Name -> Ordering)
-> (Rule i -> Name) -> Rule i -> Rule i -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rule i -> Name
forall i. Rule i -> Name
ruleName

-- |
--   A range operator can be used to join two type expressions that stand
--   for either two integer values or two floating-point values; it
--   matches any value that is between the two values, where the first
--   value is always included in the matching set and the second value is
--   included for ".." and excluded for "...".
data RangeBound = ClOpen | Closed
  deriving (RangeBound -> RangeBound -> Bool
(RangeBound -> RangeBound -> Bool)
-> (RangeBound -> RangeBound -> Bool) -> Eq RangeBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RangeBound -> RangeBound -> Bool
== :: RangeBound -> RangeBound -> Bool
$c/= :: RangeBound -> RangeBound -> Bool
/= :: RangeBound -> RangeBound -> Bool
Eq, (forall x. RangeBound -> Rep RangeBound x)
-> (forall x. Rep RangeBound x -> RangeBound) -> Generic RangeBound
forall x. Rep RangeBound x -> RangeBound
forall x. RangeBound -> Rep RangeBound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RangeBound -> Rep RangeBound x
from :: forall x. RangeBound -> Rep RangeBound x
$cto :: forall x. Rep RangeBound x -> RangeBound
to :: forall x. Rep RangeBound x -> RangeBound
Generic, Int -> RangeBound -> ShowS
[RangeBound] -> ShowS
RangeBound -> String
(Int -> RangeBound -> ShowS)
-> (RangeBound -> String)
-> ([RangeBound] -> ShowS)
-> Show RangeBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RangeBound -> ShowS
showsPrec :: Int -> RangeBound -> ShowS
$cshow :: RangeBound -> String
show :: RangeBound -> String
$cshowList :: [RangeBound] -> ShowS
showList :: [RangeBound] -> ShowS
Show)
  deriving anyclass ([RangeBound] -> Expr
RangeBound -> Expr
(RangeBound -> Expr) -> ([RangeBound] -> Expr) -> ToExpr RangeBound
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: RangeBound -> Expr
toExpr :: RangeBound -> Expr
$clistToExpr :: [RangeBound] -> Expr
listToExpr :: [RangeBound] -> Expr
ToExpr)

instance Hashable RangeBound

data TyOp = RangeOp RangeBound | CtrlOp CtlOp
  deriving (TyOp -> TyOp -> Bool
(TyOp -> TyOp -> Bool) -> (TyOp -> TyOp -> Bool) -> Eq TyOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyOp -> TyOp -> Bool
== :: TyOp -> TyOp -> Bool
$c/= :: TyOp -> TyOp -> Bool
/= :: TyOp -> TyOp -> Bool
Eq, (forall x. TyOp -> Rep TyOp x)
-> (forall x. Rep TyOp x -> TyOp) -> Generic TyOp
forall x. Rep TyOp x -> TyOp
forall x. TyOp -> Rep TyOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TyOp -> Rep TyOp x
from :: forall x. TyOp -> Rep TyOp x
$cto :: forall x. Rep TyOp x -> TyOp
to :: forall x. Rep TyOp x -> TyOp
Generic, Int -> TyOp -> ShowS
[TyOp] -> ShowS
TyOp -> String
(Int -> TyOp -> ShowS)
-> (TyOp -> String) -> ([TyOp] -> ShowS) -> Show TyOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TyOp -> ShowS
showsPrec :: Int -> TyOp -> ShowS
$cshow :: TyOp -> String
show :: TyOp -> String
$cshowList :: [TyOp] -> ShowS
showList :: [TyOp] -> ShowS
Show)
  deriving anyclass ([TyOp] -> Expr
TyOp -> Expr
(TyOp -> Expr) -> ([TyOp] -> Expr) -> ToExpr TyOp
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: TyOp -> Expr
toExpr :: TyOp -> Expr
$clistToExpr :: [TyOp] -> Expr
listToExpr :: [TyOp] -> Expr
ToExpr)

data TypeOrGroup i = TOGType (Type0 i) | TOGGroup (GroupEntry i)
  deriving ((forall x. TypeOrGroup i -> Rep (TypeOrGroup i) x)
-> (forall x. Rep (TypeOrGroup i) x -> TypeOrGroup i)
-> Generic (TypeOrGroup i)
forall x. Rep (TypeOrGroup i) x -> TypeOrGroup i
forall x. TypeOrGroup i -> Rep (TypeOrGroup i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (TypeOrGroup i) x -> TypeOrGroup i
forall i x. TypeOrGroup i -> Rep (TypeOrGroup i) x
$cfrom :: forall i x. TypeOrGroup i -> Rep (TypeOrGroup i) x
from :: forall x. TypeOrGroup i -> Rep (TypeOrGroup i) x
$cto :: forall i x. Rep (TypeOrGroup i) x -> TypeOrGroup i
to :: forall x. Rep (TypeOrGroup i) x -> TypeOrGroup i
Generic)

deriving instance ForAllExtensions i Eq => Eq (TypeOrGroup i)

deriving instance ForAllExtensions i Show => Show (TypeOrGroup i)

deriving instance ForAllExtensions i ToExpr => ToExpr (TypeOrGroup i)

instance ForAllExtensions i CollectComments => CollectComments (TypeOrGroup i)

{-- |
   The group that is used to define a map or an array can often be reused in the
   definition of another map or array.  Similarly, a type defined as a tag
   carries an internal data item that one would like to refer to.  In these
   cases, it is expedient to simply use the name of the map, array, or tag type
   as a handle for the group or type defined inside it.

   The "unwrap" operator (written by preceding a name by a tilde character "~")
   can be used to strip the type defined for a name by one layer, exposing the
   underlying group (for maps and arrays) or type (for tags).

   For example, an application might want to define a basic header and an
   advanced header.  Without unwrapping, this might be done as follows:

             basic-header-group = (
               field1: int,
               field2: text,
             )

             basic-header = [ basic-header-group ]

             advanced-header = [
               basic-header-group,
               field3: bytes,
               field4: number, ; as in the tagged type "time"
             ]

   Unwrapping simplifies this to:

                            basic-header = [
                              field1: int,
                              field2: text,
                            ]

                            advanced-header = [
                              ~basic-header,
                              field3: bytes,
                              field4: ~time,
                            ]

   (Note that leaving out the first unwrap operator in the latter example would
   lead to nesting the basic-header in its own array inside the advanced-header,
   while, with the unwrapped basic-header, the definition of the group inside
   basic-header is essentially repeated inside advanced-header, leading to a
   single array.  This can be used for various applications often solved by
   inheritance in programming languages.  The effect of unwrapping can also be
   described as "threading in" the group or type inside the referenced type,
   which suggested the thread-like "~" character.)
-}
unwrap :: TypeOrGroup i -> Maybe (Group i)
unwrap :: forall i. TypeOrGroup i -> Maybe (Group i)
unwrap (TOGType (Type0 (Type1 Type2 i
t2 Maybe (TyOp, Type2 i)
Nothing XTerm i
_ NE.:| []))) = case Type2 i
t2 of
  T2Map Group i
g -> Group i -> Maybe (Group i)
forall a. a -> Maybe a
Just Group i
g
  T2Array Group i
g -> Group i -> Maybe (Group i)
forall a. a -> Maybe a
Just Group i
g
  Type2 i
_ -> Maybe (Group i)
forall a. Maybe a
Nothing
unwrap TypeOrGroup i
_ = Maybe (Group i)
forall a. Maybe a
Nothing

-- |
-- A type can be given as a choice between one or more types.  The
--   choice matches a data item if the data item matches any one of the
--   types given in the choice.
newtype Type0 i = Type0 {forall i. Type0 i -> NonEmpty (Type1 i)
t0Type1 :: NE.NonEmpty (Type1 i)}
  deriving ((forall x. Type0 i -> Rep (Type0 i) x)
-> (forall x. Rep (Type0 i) x -> Type0 i) -> Generic (Type0 i)
forall x. Rep (Type0 i) x -> Type0 i
forall x. Type0 i -> Rep (Type0 i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Type0 i) x -> Type0 i
forall i x. Type0 i -> Rep (Type0 i) x
$cfrom :: forall i x. Type0 i -> Rep (Type0 i) x
from :: forall x. Type0 i -> Rep (Type0 i) x
$cto :: forall i x. Rep (Type0 i) x -> Type0 i
to :: forall x. Rep (Type0 i) x -> Type0 i
Generic)
  deriving newtype (NonEmpty (Type0 i) -> Type0 i
Type0 i -> Type0 i -> Type0 i
(Type0 i -> Type0 i -> Type0 i)
-> (NonEmpty (Type0 i) -> Type0 i)
-> (forall b. Integral b => b -> Type0 i -> Type0 i)
-> Semigroup (Type0 i)
forall b. Integral b => b -> Type0 i -> Type0 i
forall i. NonEmpty (Type0 i) -> Type0 i
forall i. Type0 i -> Type0 i -> Type0 i
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall i b. Integral b => b -> Type0 i -> Type0 i
$c<> :: forall i. Type0 i -> Type0 i -> Type0 i
<> :: Type0 i -> Type0 i -> Type0 i
$csconcat :: forall i. NonEmpty (Type0 i) -> Type0 i
sconcat :: NonEmpty (Type0 i) -> Type0 i
$cstimes :: forall i b. Integral b => b -> Type0 i -> Type0 i
stimes :: forall b. Integral b => b -> Type0 i -> Type0 i
Semigroup)

deriving instance ForAllExtensions i Eq => Eq (Type0 i)

deriving instance ForAllExtensions i Show => Show (Type0 i)

deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (Type0 i)

instance ForAllExtensions i CollectComments => CollectComments (Type0 i)

-- |
-- Two types can be combined with a range operator (see below)
data Type1 i = Type1
  { forall i. Type1 i -> Type2 i
t1Main :: Type2 i
  , forall i. Type1 i -> Maybe (TyOp, Type2 i)
t1TyOp :: Maybe (TyOp, Type2 i)
  , forall i. Type1 i -> XTerm i
t1Comment :: XTerm i
  }
  deriving ((forall x. Type1 i -> Rep (Type1 i) x)
-> (forall x. Rep (Type1 i) x -> Type1 i) -> Generic (Type1 i)
forall x. Rep (Type1 i) x -> Type1 i
forall x. Type1 i -> Rep (Type1 i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Type1 i) x -> Type1 i
forall i x. Type1 i -> Rep (Type1 i) x
$cfrom :: forall i x. Type1 i -> Rep (Type1 i) x
from :: forall x. Type1 i -> Rep (Type1 i) x
$cto :: forall i x. Rep (Type1 i) x -> Type1 i
to :: forall x. Rep (Type1 i) x -> Type1 i
Generic)

deriving instance ForAllExtensions i Eq => Eq (Type1 i)

deriving instance ForAllExtensions i Show => Show (Type1 i)

deriving instance ForAllExtensions i ToExpr => ToExpr (Type1 i)

instance HasComment (XTerm i) => HasComment (Type1 i) where
  commentL :: Lens' (Type1 i) Comment
commentL = Optic A_Lens NoIx (Type1 i) (Type1 i) (XTerm i) (XTerm i)
#t1Comment Optic A_Lens NoIx (Type1 i) (Type1 i) (XTerm i) (XTerm i)
-> Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
-> Lens' (Type1 i) Comment
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
forall a. HasComment a => Lens' a Comment
commentL

instance ForAllExtensions i CollectComments => CollectComments (Type1 i) where
  collectComments :: Type1 i -> [Comment]
collectComments (Type1 Type2 i
m Maybe (TyOp, Type2 i)
tyOp XTerm i
c) = XTerm i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments XTerm i
c [Comment] -> [Comment] -> [Comment]
forall a. Semigroup a => a -> a -> a
<> Type2 i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments Type2 i
m [Comment] -> [Comment] -> [Comment]
forall a. Semigroup a => a -> a -> a
<> Maybe (Type2 i) -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments (((TyOp, Type2 i) -> Type2 i)
-> Maybe (TyOp, Type2 i) -> Maybe (Type2 i)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TyOp, Type2 i) -> Type2 i
forall a b. (a, b) -> b
snd Maybe (TyOp, Type2 i)
tyOp)

data Type2 i
  = -- | A type can be just a single value (such as 1 or "icecream" or
    --   h'0815'), which matches only a data item with that specific value
    --   (no conversions defined),
    T2Value Value
  | -- | or be defined by a rule giving a meaning to a name (possibly after
    --   supplying generic arguments as required by the generic parameters)
    T2Name Name (Maybe (GenericArg i))
  | -- | or be defined in a parenthesized type expression (parentheses may be
    --   necessary to override some operator precedence),
    T2Group (Type0 i)
  | -- | a map expression, which matches a valid CBOR map the key/value pairs
    --  of which can be ordered in such a way that the resulting sequence
    --  matches the group expression, or
    T2Map (Group i)
  | -- | an array expression, which matches a CBOR array the elements of which
    -- when taken as values and complemented by a wildcard (matches
    -- anything) key each -- match the group, or
    T2Array (Group i)
  | -- | an "unwrapped" group (see Section 3.7), which matches the group
    --  inside a type defined as a map or an array by wrapping the group, or
    T2Unwrapped Name (Maybe (GenericArg i))
  | -- | an enumeration expression, which matches any value that is within the
    --  set of values that the values of the group given can take, or
    T2Enum (Group i)
  | T2EnumRef Name (Maybe (GenericArg i))
  | -- | a tagged data item, tagged with the "uint" given and containing the
    --  type given as the tagged value, or
    T2Tag (Maybe Word64) (Type0 i)
  | -- | a data item of a major type (given by the DIGIT), optionally
    --  constrained to the additional information given by the uint, or
    T2DataItem Word8 (Maybe Word64)
  | -- | Any data item
    T2Any
  | XXType2 (XXType2 i)
  deriving ((forall x. Type2 i -> Rep (Type2 i) x)
-> (forall x. Rep (Type2 i) x -> Type2 i) -> Generic (Type2 i)
forall x. Rep (Type2 i) x -> Type2 i
forall x. Type2 i -> Rep (Type2 i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Type2 i) x -> Type2 i
forall i x. Type2 i -> Rep (Type2 i) x
$cfrom :: forall i x. Type2 i -> Rep (Type2 i) x
from :: forall x. Type2 i -> Rep (Type2 i) x
$cto :: forall i x. Rep (Type2 i) x -> Type2 i
to :: forall x. Rep (Type2 i) x -> Type2 i
Generic)

deriving instance ForAllExtensions i Eq => Eq (Type2 i)

deriving instance ForAllExtensions i Show => Show (Type2 i)

deriving instance ForAllExtensions i ToExpr => ToExpr (Type2 i)

instance ForAllExtensions i CollectComments => CollectComments (Type2 i)

-- |
--  An optional _occurrence_ indicator can be given in front of a group
--  entry.  It is either (1) one of the characters "?" (optional), "*"
--  (zero or more), or "+" (one or more) or (2) of the form n*m, where n
--  and m are optional unsigned integers and n is the lower limit
--  (default 0) and m is the upper limit (default no limit) of
--  occurrences.
--
--  If no occurrence indicator is specified, the group entry is to occur
--  exactly once (as if 1*1 were specified).  A group entry with an
--  occurrence indicator matches sequences of name/value pairs that are
--  composed by concatenating a number of sequences that the basic group
--  entry matches, where the number needs to be allowed by the occurrence
--  indicator.
data OccurrenceIndicator
  = OIOptional
  | OIZeroOrMore
  | OIOneOrMore
  | OIBounded (Maybe Word64) (Maybe Word64)
  deriving (OccurrenceIndicator -> OccurrenceIndicator -> Bool
(OccurrenceIndicator -> OccurrenceIndicator -> Bool)
-> (OccurrenceIndicator -> OccurrenceIndicator -> Bool)
-> Eq OccurrenceIndicator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OccurrenceIndicator -> OccurrenceIndicator -> Bool
== :: OccurrenceIndicator -> OccurrenceIndicator -> Bool
$c/= :: OccurrenceIndicator -> OccurrenceIndicator -> Bool
/= :: OccurrenceIndicator -> OccurrenceIndicator -> Bool
Eq, (forall x. OccurrenceIndicator -> Rep OccurrenceIndicator x)
-> (forall x. Rep OccurrenceIndicator x -> OccurrenceIndicator)
-> Generic OccurrenceIndicator
forall x. Rep OccurrenceIndicator x -> OccurrenceIndicator
forall x. OccurrenceIndicator -> Rep OccurrenceIndicator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OccurrenceIndicator -> Rep OccurrenceIndicator x
from :: forall x. OccurrenceIndicator -> Rep OccurrenceIndicator x
$cto :: forall x. Rep OccurrenceIndicator x -> OccurrenceIndicator
to :: forall x. Rep OccurrenceIndicator x -> OccurrenceIndicator
Generic, Int -> OccurrenceIndicator -> ShowS
[OccurrenceIndicator] -> ShowS
OccurrenceIndicator -> String
(Int -> OccurrenceIndicator -> ShowS)
-> (OccurrenceIndicator -> String)
-> ([OccurrenceIndicator] -> ShowS)
-> Show OccurrenceIndicator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OccurrenceIndicator -> ShowS
showsPrec :: Int -> OccurrenceIndicator -> ShowS
$cshow :: OccurrenceIndicator -> String
show :: OccurrenceIndicator -> String
$cshowList :: [OccurrenceIndicator] -> ShowS
showList :: [OccurrenceIndicator] -> ShowS
Show)
  deriving anyclass ([OccurrenceIndicator] -> Expr
OccurrenceIndicator -> Expr
(OccurrenceIndicator -> Expr)
-> ([OccurrenceIndicator] -> Expr) -> ToExpr OccurrenceIndicator
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: OccurrenceIndicator -> Expr
toExpr :: OccurrenceIndicator -> Expr
$clistToExpr :: [OccurrenceIndicator] -> Expr
listToExpr :: [OccurrenceIndicator] -> Expr
ToExpr)

instance Hashable OccurrenceIndicator

-- |
--   A group matches any sequence of key/value pairs that matches any of
--   the choices given (again using PEG semantics).
newtype Group i = Group {forall i. Group i -> NonEmpty (GrpChoice i)
unGroup :: NE.NonEmpty (GrpChoice i)}
  deriving ((forall x. Group i -> Rep (Group i) x)
-> (forall x. Rep (Group i) x -> Group i) -> Generic (Group i)
forall x. Rep (Group i) x -> Group i
forall x. Group i -> Rep (Group i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Group i) x -> Group i
forall i x. Group i -> Rep (Group i) x
$cfrom :: forall i x. Group i -> Rep (Group i) x
from :: forall x. Group i -> Rep (Group i) x
$cto :: forall i x. Rep (Group i) x -> Group i
to :: forall x. Rep (Group i) x -> Group i
Generic)
  deriving newtype (NonEmpty (Group i) -> Group i
Group i -> Group i -> Group i
(Group i -> Group i -> Group i)
-> (NonEmpty (Group i) -> Group i)
-> (forall b. Integral b => b -> Group i -> Group i)
-> Semigroup (Group i)
forall b. Integral b => b -> Group i -> Group i
forall i. NonEmpty (Group i) -> Group i
forall i. Group i -> Group i -> Group i
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall i b. Integral b => b -> Group i -> Group i
$c<> :: forall i. Group i -> Group i -> Group i
<> :: Group i -> Group i -> Group i
$csconcat :: forall i. NonEmpty (Group i) -> Group i
sconcat :: NonEmpty (Group i) -> Group i
$cstimes :: forall i b. Integral b => b -> Group i -> Group i
stimes :: forall b. Integral b => b -> Group i -> Group i
Semigroup)

deriving instance ForAllExtensions i Eq => Eq (Group i)

deriving instance ForAllExtensions i Show => Show (Group i)

deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (Group i)

instance HasComment (XTerm i) => HasComment (Group i) where
  commentL :: Lens' (Group i) Comment
commentL = Optic
  A_Lens
  NoIx
  (Group i)
  (Group i)
  (NonEmpty (GrpChoice i))
  (NonEmpty (GrpChoice i))
#unGroup Optic
  A_Lens
  NoIx
  (Group i)
  (Group i)
  (NonEmpty (GrpChoice i))
  (NonEmpty (GrpChoice i))
-> Optic
     A_Lens
     NoIx
     (NonEmpty (GrpChoice i))
     (NonEmpty (GrpChoice i))
     Comment
     Comment
-> Lens' (Group i) Comment
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (NonEmpty (GrpChoice i))
  (NonEmpty (GrpChoice i))
  Comment
  Comment
forall a. HasComment a => Lens' a Comment
commentL

instance ForAllExtensions i CollectComments => CollectComments (Group i) where
  collectComments :: Group i -> [Comment]
collectComments (Group NonEmpty (GrpChoice i)
xs) = (GrpChoice i -> [Comment]) -> NonEmpty (GrpChoice i) -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GrpChoice i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments NonEmpty (GrpChoice i)
xs

data GrpChoice i = GrpChoice
  { forall i. GrpChoice i -> [GroupEntry i]
gcGroupEntries :: [GroupEntry i]
  , forall i. GrpChoice i -> XTerm i
gcComment :: XTerm i
  }
  deriving ((forall x. GrpChoice i -> Rep (GrpChoice i) x)
-> (forall x. Rep (GrpChoice i) x -> GrpChoice i)
-> Generic (GrpChoice i)
forall x. Rep (GrpChoice i) x -> GrpChoice i
forall x. GrpChoice i -> Rep (GrpChoice i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (GrpChoice i) x -> GrpChoice i
forall i x. GrpChoice i -> Rep (GrpChoice i) x
$cfrom :: forall i x. GrpChoice i -> Rep (GrpChoice i) x
from :: forall x. GrpChoice i -> Rep (GrpChoice i) x
$cto :: forall i x. Rep (GrpChoice i) x -> GrpChoice i
to :: forall x. Rep (GrpChoice i) x -> GrpChoice i
Generic)

deriving instance ForAllExtensions i Eq => Eq (GrpChoice i)

deriving instance ForAllExtensions i Show => Show (GrpChoice i)

deriving instance ForAllExtensions i ToExpr => ToExpr (GrpChoice i)

instance HasComment (XTerm i) => HasComment (GrpChoice i) where
  commentL :: Lens' (GrpChoice i) Comment
commentL = Optic A_Lens NoIx (GrpChoice i) (GrpChoice i) (XTerm i) (XTerm i)
#gcComment Optic A_Lens NoIx (GrpChoice i) (GrpChoice i) (XTerm i) (XTerm i)
-> Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
-> Lens' (GrpChoice i) Comment
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
forall a. HasComment a => Lens' a Comment
commentL

instance ForAllExtensions i CollectComments => CollectComments (GrpChoice i) where
  collectComments :: GrpChoice i -> [Comment]
collectComments (GrpChoice [GroupEntry i]
ges XTerm i
c) = XTerm i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments XTerm i
c [Comment] -> [Comment] -> [Comment]
forall a. Semigroup a => a -> a -> a
<> (GroupEntry i -> [Comment]) -> [GroupEntry i] -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GroupEntry i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments [GroupEntry i]
ges

-- |
--  A group entry can be given by a value type, which needs to be matched
--  by the value part of a single element; and, optionally, a memberkey
--  type, which needs to be matched by the key part of the element, if
--  the memberkey is given.  If the memberkey is not given, the entry can
--  only be used for matching arrays, not for maps.  (See below for how
--  that is modified by the occurrence indicator.)
data GroupEntry i = GroupEntry
  { forall i. GroupEntry i -> Maybe OccurrenceIndicator
geOccurrenceIndicator :: Maybe OccurrenceIndicator
  , forall i. GroupEntry i -> GroupEntryVariant i
geVariant :: GroupEntryVariant i
  , forall i. GroupEntry i -> XTerm i
geExt :: XTerm i
  }
  deriving ((forall x. GroupEntry i -> Rep (GroupEntry i) x)
-> (forall x. Rep (GroupEntry i) x -> GroupEntry i)
-> Generic (GroupEntry i)
forall x. Rep (GroupEntry i) x -> GroupEntry i
forall x. GroupEntry i -> Rep (GroupEntry i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (GroupEntry i) x -> GroupEntry i
forall i x. GroupEntry i -> Rep (GroupEntry i) x
$cfrom :: forall i x. GroupEntry i -> Rep (GroupEntry i) x
from :: forall x. GroupEntry i -> Rep (GroupEntry i) x
$cto :: forall i x. Rep (GroupEntry i) x -> GroupEntry i
to :: forall x. Rep (GroupEntry i) x -> GroupEntry i
Generic)

deriving instance ForAllExtensions i Eq => Eq (GroupEntry i)

deriving instance ForAllExtensions i Show => Show (GroupEntry i)

deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntry i)

instance ForAllExtensions i CollectComments => CollectComments (GroupEntry i) where
  collectComments :: GroupEntry i -> [Comment]
collectComments (GroupEntry Maybe OccurrenceIndicator
_ GroupEntryVariant i
c XTerm i
x) = GroupEntryVariant i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments GroupEntryVariant i
c [Comment] -> [Comment] -> [Comment]
forall a. Semigroup a => a -> a -> a
<> XTerm i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments XTerm i
x

data GroupEntryVariant i
  = GEType (Maybe (MemberKey i)) (Type0 i)
  | GERef Name (Maybe (GenericArg i))
  | GEGroup (Group i)
  deriving ((forall x. GroupEntryVariant i -> Rep (GroupEntryVariant i) x)
-> (forall x. Rep (GroupEntryVariant i) x -> GroupEntryVariant i)
-> Generic (GroupEntryVariant i)
forall x. Rep (GroupEntryVariant i) x -> GroupEntryVariant i
forall x. GroupEntryVariant i -> Rep (GroupEntryVariant i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (GroupEntryVariant i) x -> GroupEntryVariant i
forall i x. GroupEntryVariant i -> Rep (GroupEntryVariant i) x
$cfrom :: forall i x. GroupEntryVariant i -> Rep (GroupEntryVariant i) x
from :: forall x. GroupEntryVariant i -> Rep (GroupEntryVariant i) x
$cto :: forall i x. Rep (GroupEntryVariant i) x -> GroupEntryVariant i
to :: forall x. Rep (GroupEntryVariant i) x -> GroupEntryVariant i
Generic)

deriving instance ForAllExtensions i Eq => Eq (GroupEntryVariant i)

deriving instance ForAllExtensions i Show => Show (GroupEntryVariant i)

deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntryVariant i)

instance HasComment (XTerm i) => HasComment (GroupEntry i) where
  commentL :: Lens' (GroupEntry i) Comment
commentL = Optic A_Lens NoIx (GroupEntry i) (GroupEntry i) (XTerm i) (XTerm i)
#geExt Optic A_Lens NoIx (GroupEntry i) (GroupEntry i) (XTerm i) (XTerm i)
-> Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
-> Lens' (GroupEntry i) Comment
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (XTerm i) (XTerm i) Comment Comment
forall a. HasComment a => Lens' a Comment
commentL

instance ForAllExtensions i CollectComments => CollectComments (GroupEntryVariant i) where
  collectComments :: GroupEntryVariant i -> [Comment]
collectComments (GEType Maybe (MemberKey i)
_ Type0 i
t0) = Type0 i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments Type0 i
t0
  collectComments (GERef Name
n Maybe (GenericArg i)
mga) = Name -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments Name
n [Comment] -> [Comment] -> [Comment]
forall a. Semigroup a => a -> a -> a
<> Maybe (GenericArg i) -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments Maybe (GenericArg i)
mga
  collectComments (GEGroup Group i
g) = Group i -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments Group i
g

-- |
--  Key types can be given by a type expression, a bareword (which stands
--  for a type that just contains a string value created from this
--  bareword), or a value (which stands for a type that just contains
--  this value).  A key value matches its key type if the key value is a
--  member of the key type, unless a cut preceding it in the group
--  applies (see Section 3.5.4 for how map matching is influenced by the
--  presence of the cuts denoted by "^" or ":" in previous entries).
data MemberKey i
  = MKType (Type1 i)
  | MKBareword Name
  | MKValue Value
  deriving ((forall x. MemberKey i -> Rep (MemberKey i) x)
-> (forall x. Rep (MemberKey i) x -> MemberKey i)
-> Generic (MemberKey i)
forall x. Rep (MemberKey i) x -> MemberKey i
forall x. MemberKey i -> Rep (MemberKey i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (MemberKey i) x -> MemberKey i
forall i x. MemberKey i -> Rep (MemberKey i) x
$cfrom :: forall i x. MemberKey i -> Rep (MemberKey i) x
from :: forall x. MemberKey i -> Rep (MemberKey i) x
$cto :: forall i x. Rep (MemberKey i) x -> MemberKey i
to :: forall x. Rep (MemberKey i) x -> MemberKey i
Generic)

deriving instance ForAllExtensions i Eq => Eq (MemberKey i)

deriving instance ForAllExtensions i Show => Show (MemberKey i)

deriving instance ForAllExtensions i ToExpr => ToExpr (MemberKey i)

data Value = Value ValueVariant Comment
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Value
Value -> Default Value
forall a. a -> Default a
$cdef :: Value
def :: Value
Default)
  deriving anyclass ([Value] -> Expr
Value -> Expr
(Value -> Expr) -> ([Value] -> Expr) -> ToExpr Value
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: Value -> Expr
toExpr :: Value -> Expr
$clistToExpr :: [Value] -> Expr
listToExpr :: [Value] -> Expr
ToExpr, Eq Value
Eq Value =>
(Int -> Value -> Int) -> (Value -> Int) -> Hashable Value
Int -> Value -> Int
Value -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Value -> Int
hashWithSalt :: Int -> Value -> Int
$chash :: Value -> Int
hash :: Value -> Int
Hashable, Value -> [Comment]
(Value -> [Comment]) -> CollectComments Value
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: Value -> [Comment]
collectComments :: Value -> [Comment]
CollectComments)

value :: ValueVariant -> Value
value :: ValueVariant -> Value
value ValueVariant
x = ValueVariant -> Comment -> Value
Value ValueVariant
x Comment
forall a. Monoid a => a
mempty

data ValueVariant
  = VUInt Word64
  | VNInt Word64
  | VBignum Integer
  | VFloat16 Float
  | VFloat32 Float
  | VFloat64 Double
  | VText T.Text
  | VBytes B.ByteString
  | VBool Bool
  deriving (ValueVariant -> ValueVariant -> Bool
(ValueVariant -> ValueVariant -> Bool)
-> (ValueVariant -> ValueVariant -> Bool) -> Eq ValueVariant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueVariant -> ValueVariant -> Bool
== :: ValueVariant -> ValueVariant -> Bool
$c/= :: ValueVariant -> ValueVariant -> Bool
/= :: ValueVariant -> ValueVariant -> Bool
Eq, (forall x. ValueVariant -> Rep ValueVariant x)
-> (forall x. Rep ValueVariant x -> ValueVariant)
-> Generic ValueVariant
forall x. Rep ValueVariant x -> ValueVariant
forall x. ValueVariant -> Rep ValueVariant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValueVariant -> Rep ValueVariant x
from :: forall x. ValueVariant -> Rep ValueVariant x
$cto :: forall x. Rep ValueVariant x -> ValueVariant
to :: forall x. Rep ValueVariant x -> ValueVariant
Generic, Int -> ValueVariant -> ShowS
[ValueVariant] -> ShowS
ValueVariant -> String
(Int -> ValueVariant -> ShowS)
-> (ValueVariant -> String)
-> ([ValueVariant] -> ShowS)
-> Show ValueVariant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueVariant -> ShowS
showsPrec :: Int -> ValueVariant -> ShowS
$cshow :: ValueVariant -> String
show :: ValueVariant -> String
$cshowList :: [ValueVariant] -> ShowS
showList :: [ValueVariant] -> ShowS
Show, ValueVariant
ValueVariant -> Default ValueVariant
forall a. a -> Default a
$cdef :: ValueVariant
def :: ValueVariant
Default)
  deriving anyclass ([ValueVariant] -> Expr
ValueVariant -> Expr
(ValueVariant -> Expr)
-> ([ValueVariant] -> Expr) -> ToExpr ValueVariant
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: ValueVariant -> Expr
toExpr :: ValueVariant -> Expr
$clistToExpr :: [ValueVariant] -> Expr
listToExpr :: [ValueVariant] -> Expr
ToExpr, Eq ValueVariant
Eq ValueVariant =>
(Int -> ValueVariant -> Int)
-> (ValueVariant -> Int) -> Hashable ValueVariant
Int -> ValueVariant -> Int
ValueVariant -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ValueVariant -> Int
hashWithSalt :: Int -> ValueVariant -> Int
$chash :: ValueVariant -> Int
hash :: ValueVariant -> Int
Hashable, ValueVariant -> [Comment]
(ValueVariant -> [Comment]) -> CollectComments ValueVariant
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: ValueVariant -> [Comment]
collectComments :: ValueVariant -> [Comment]
CollectComments)