{-# OPTIONS_GHC -fno-warn-orphans     #-}

module Agda.TypeChecking.Serialise.Instances.Errors where

import Control.Monad

import Agda.TypeChecking.Serialise.Base
import Agda.TypeChecking.Serialise.Instances.Internal () --instance only
import Agda.TypeChecking.Serialise.Instances.Abstract () --instance only

import Agda.Syntax.Concrete.Definitions (DeclarationWarning(..), DeclarationWarning'(..))
import Agda.Syntax.Parser.Monad
import Agda.TypeChecking.Monad.Base
import Agda.Interaction.Options
import Agda.Interaction.Options.Warnings
import Agda.Interaction.Library.Base
import Agda.Termination.CutOff
import Agda.Utils.Pretty
import Agda.Utils.ProfileOptions

import Agda.Utils.Impossible

instance EmbPrj TCWarning where
  icod_ :: TCWarning -> S Int32
icod_ (TCWarning CallStack
fp Range
a Warning
b Doc
c Bool
d) = (CallStack -> Range -> Warning -> Doc -> Bool -> TCWarning)
-> Arrows
     (Domains
        (CallStack -> Range -> Warning -> Doc -> Bool -> TCWarning))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' CallStack -> Range -> Warning -> Doc -> Bool -> TCWarning
TCWarning CallStack
fp Range
a Warning
b Doc
c Bool
d
  value :: Int32 -> R TCWarning
value = (CallStack -> Range -> Warning -> Doc -> Bool -> TCWarning)
-> Int32
-> R (CoDomain
        (CallStack -> Range -> Warning -> Doc -> Bool -> TCWarning))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN CallStack -> Range -> Warning -> Doc -> Bool -> TCWarning
TCWarning

-- We don't need to serialise warnings that turn into errors
instance EmbPrj Warning where
  icod_ :: Warning -> S Int32
icod_ = \case
    TerminationIssue [TerminationError]
a                    -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    UnreachableClauses QName
a [Range]
b                -> Int32
-> (QName -> [Range] -> Warning)
-> Arrows (Domains (QName -> [Range] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 QName -> [Range] -> Warning
UnreachableClauses QName
a [Range]
b
    CoverageIssue QName
a [(Telescope, [NamedArg DeBruijnPattern])]
b                     -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    NotStrictlyPositive QName
a Seq OccursWhere
b               -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    UnsolvedMetaVariables [Range]
a               -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    UnsolvedInteractionMetas [Range]
a            -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    UnsolvedConstraints Constraints
a                 -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    OldBuiltin String
a String
b                        -> Int32
-> (String -> String -> Warning)
-> Arrows (Domains (String -> String -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 String -> String -> Warning
OldBuiltin String
a String
b
    Warning
EmptyRewritePragma                    -> Int32 -> Warning -> Arrows (Domains Warning) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 Warning
EmptyRewritePragma
    Warning
UselessPublic                         -> Int32 -> Warning -> Arrows (Domains Warning) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
3 Warning
UselessPublic
    UselessInline QName
a                       -> Int32
-> (QName -> Warning)
-> Arrows (Domains (QName -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
4 QName -> Warning
UselessInline QName
a
    GenericWarning Doc
a                      -> Int32
-> (Doc -> Warning) -> Arrows (Domains (Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
5 Doc -> Warning
GenericWarning Doc
a
    GenericNonFatalError Doc
a                -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    SafeFlagPostulate Name
a                   -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    SafeFlagPragma [String]
a                      -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagNonTerminating                -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagTerminating                   -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagWithoutKFlagPrimEraseEquality -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagNoPositivityCheck             -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagPolarity                      -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagNoUniverseCheck               -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagNoCoverageCheck               -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagInjective                     -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    Warning
SafeFlagEta                           -> S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
    DeprecationWarning String
a String
b String
c              -> Int32
-> (String -> String -> String -> Warning)
-> Arrows
     (Domains (String -> String -> String -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
6 String -> String -> String -> Warning
DeprecationWarning String
a String
b String
c
    NicifierIssue DeclarationWarning
a                       -> Int32
-> (DeclarationWarning -> Warning)
-> Arrows (Domains (DeclarationWarning -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
7 DeclarationWarning -> Warning
NicifierIssue DeclarationWarning
a
    InversionDepthReached QName
a               -> Int32
-> (QName -> Warning)
-> Arrows (Domains (QName -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
8 QName -> Warning
InversionDepthReached QName
a
    UserWarning Text
a                         -> Int32
-> (Text -> Warning)
-> Arrows (Domains (Text -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
9 Text -> Warning
UserWarning Text
a
    AbsurdPatternRequiresNoRHS [NamedArg DeBruijnPattern]
a          -> Int32
-> ([NamedArg DeBruijnPattern] -> Warning)
-> Arrows
     (Domains ([NamedArg DeBruijnPattern] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
10 [NamedArg DeBruijnPattern] -> Warning
AbsurdPatternRequiresNoRHS [NamedArg DeBruijnPattern]
a
    ModuleDoesntExport QName
a [Name]
b [Name]
c [ImportedName]
d            -> Int32
-> (QName -> [Name] -> [Name] -> [ImportedName] -> Warning)
-> Arrows
     (Domains (QName -> [Name] -> [Name] -> [ImportedName] -> Warning))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
11 QName -> [Name] -> [Name] -> [ImportedName] -> Warning
ModuleDoesntExport QName
a [Name]
b [Name]
c [ImportedName]
d
    LibraryWarning LibWarning
a                      -> Int32
-> (LibWarning -> Warning)
-> Arrows (Domains (LibWarning -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
12 LibWarning -> Warning
LibraryWarning LibWarning
a
    CoverageNoExactSplit QName
a [Clause]
b              -> Int32
-> (QName -> [Clause] -> Warning)
-> Arrows (Domains (QName -> [Clause] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
13 QName -> [Clause] -> Warning
CoverageNoExactSplit QName
a [Clause]
b
    CantGeneralizeOverSorts [MetaId]
a             -> Int32
-> ([MetaId] -> Warning)
-> Arrows (Domains ([MetaId] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
14 [MetaId] -> Warning
CantGeneralizeOverSorts [MetaId]
a
    IllformedAsClause String
a                   -> Int32
-> (String -> Warning)
-> Arrows (Domains (String -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
15 String -> Warning
IllformedAsClause String
a
    Warning
WithoutKFlagPrimEraseEquality         -> Int32 -> Warning -> Arrows (Domains Warning) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
16 Warning
WithoutKFlagPrimEraseEquality
    InstanceWithExplicitArg QName
a             -> Int32
-> (QName -> Warning)
-> Arrows (Domains (QName -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
17 QName -> Warning
InstanceWithExplicitArg QName
a
    InfectiveImport Doc
a                     -> Int32
-> (Doc -> Warning) -> Arrows (Domains (Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
18 Doc -> Warning
InfectiveImport Doc
a
    CoInfectiveImport Doc
a                   -> Int32
-> (Doc -> Warning) -> Arrows (Domains (Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
19 Doc -> Warning
CoInfectiveImport Doc
a
    InstanceNoOutputTypeName Doc
a            -> Int32
-> (Doc -> Warning) -> Arrows (Domains (Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
20 Doc -> Warning
InstanceNoOutputTypeName Doc
a
    InstanceArgWithExplicitArg Doc
a          -> Int32
-> (Doc -> Warning) -> Arrows (Domains (Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
21 Doc -> Warning
InstanceArgWithExplicitArg Doc
a
    Warning
WrongInstanceDeclaration              -> Int32 -> Warning -> Arrows (Domains Warning) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
22 Warning
WrongInstanceDeclaration
    RewriteNonConfluent Term
a Term
b Term
c Doc
d           -> Int32
-> (Term -> Term -> Term -> Doc -> Warning)
-> Arrows
     (Domains (Term -> Term -> Term -> Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
23 Term -> Term -> Term -> Doc -> Warning
RewriteNonConfluent Term
a Term
b Term
c Doc
d
    RewriteMaybeNonConfluent Term
a Term
b [Doc]
c        -> Int32
-> (Term -> Term -> [Doc] -> Warning)
-> Arrows (Domains (Term -> Term -> [Doc] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
24 Term -> Term -> [Doc] -> Warning
RewriteMaybeNonConfluent Term
a Term
b [Doc]
c
    PragmaCompileErased String
a QName
b               -> Int32
-> (String -> QName -> Warning)
-> Arrows (Domains (String -> QName -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
25 String -> QName -> Warning
PragmaCompileErased String
a QName
b
    FixityInRenamingModule List1 Range
a              -> Int32
-> (List1 Range -> Warning)
-> Arrows (Domains (List1 Range -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
26 List1 Range -> Warning
FixityInRenamingModule List1 Range
a
    NotInScopeW [QName]
ns                        -> Int32
-> ([QName] -> Warning)
-> Arrows (Domains ([QName] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
27 [QName] -> Warning
NotInScopeW [QName]
ns
    ClashesViaRenaming NameOrModule
a [Name]
b                -> Int32
-> (NameOrModule -> [Name] -> Warning)
-> Arrows (Domains (NameOrModule -> [Name] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
28 NameOrModule -> [Name] -> Warning
ClashesViaRenaming NameOrModule
a [Name]
b
    RecordFieldWarning RecordFieldWarning
a                  -> Int32
-> (RecordFieldWarning -> Warning)
-> Arrows (Domains (RecordFieldWarning -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
29 RecordFieldWarning -> Warning
RecordFieldWarning RecordFieldWarning
a
    UselessPatternDeclarationForRecord String
a  -> Int32
-> (String -> Warning)
-> Arrows (Domains (String -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
30 String -> Warning
UselessPatternDeclarationForRecord String
a
    Warning
EmptyWhere                            -> Int32 -> Warning -> Arrows (Domains Warning) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
31 Warning
EmptyWhere
    AsPatternShadowsConstructorOrPatternSynonym Bool
a -> Int32
-> (Bool -> Warning)
-> Arrows (Domains (Bool -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
32 Bool -> Warning
AsPatternShadowsConstructorOrPatternSynonym Bool
a
    DuplicateUsing List1 ImportedName
a                      -> Int32
-> (List1 ImportedName -> Warning)
-> Arrows (Domains (List1 ImportedName -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
33 List1 ImportedName -> Warning
DuplicateUsing List1 ImportedName
a
    UselessHiding [ImportedName]
a                       -> Int32
-> ([ImportedName] -> Warning)
-> Arrows (Domains ([ImportedName] -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
34 [ImportedName] -> Warning
UselessHiding [ImportedName]
a
    GenericUseless Range
a Doc
b                    -> Int32
-> (Range -> Doc -> Warning)
-> Arrows (Domains (Range -> Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
35 Range -> Doc -> Warning
GenericUseless Range
a Doc
b
    RewriteAmbiguousRules Term
a Term
b Term
c           -> Int32
-> (Term -> Term -> Term -> Warning)
-> Arrows (Domains (Term -> Term -> Term -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
36 Term -> Term -> Term -> Warning
RewriteAmbiguousRules Term
a Term
b Term
c
    RewriteMissingRule Term
a Term
b Term
c              -> Int32
-> (Term -> Term -> Term -> Warning)
-> Arrows (Domains (Term -> Term -> Term -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
37 Term -> Term -> Term -> Warning
RewriteMissingRule Term
a Term
b Term
c
    ParseWarning ParseWarning
a                        -> Int32
-> (ParseWarning -> Warning)
-> Arrows (Domains (ParseWarning -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
38 ParseWarning -> Warning
ParseWarning ParseWarning
a
    NoGuardednessFlag QName
a                   -> Int32
-> (QName -> Warning)
-> Arrows (Domains (QName -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
39 QName -> Warning
NoGuardednessFlag QName
a
    UnsupportedIndexedMatch Doc
f             -> Int32
-> (Doc -> Warning) -> Arrows (Domains (Doc -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
40 Doc -> Warning
UnsupportedIndexedMatch Doc
f
    OptionWarning OptionWarning
a                       -> Int32
-> (OptionWarning -> Warning)
-> Arrows (Domains (OptionWarning -> Warning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
41 OptionWarning -> Warning
OptionWarning OptionWarning
a

  value :: Int32 -> R Warning
value = (Node -> R Warning) -> Int32 -> R Warning
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R Warning) -> Int32 -> R Warning)
-> (Node -> R Warning) -> Int32 -> R Warning
forall a b. (a -> b) -> a -> b
$ \ case
    [Int32
0, Int32
a, Int32
b]            -> (QName -> [Range] -> Warning)
-> Arrows
     (Constant Int32 (Domains (QName -> [Range] -> Warning)))
     (R (CoDomain (QName -> [Range] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> [Range] -> Warning
UnreachableClauses Int32
a Int32
b
    [Int32
1, Int32
a, Int32
b]            -> (String -> String -> Warning)
-> Arrows
     (Constant Int32 (Domains (String -> String -> Warning)))
     (R (CoDomain (String -> String -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> String -> Warning
OldBuiltin Int32
a Int32
b
    [Int32
2]                  -> Warning
-> Arrows (Constant Int32 (Domains Warning)) (R (CoDomain Warning))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Warning
EmptyRewritePragma
    [Int32
3]                  -> Warning
-> Arrows (Constant Int32 (Domains Warning)) (R (CoDomain Warning))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Warning
UselessPublic
    [Int32
4, Int32
a]               -> (QName -> Warning)
-> Arrows
     (Constant Int32 (Domains (QName -> Warning)))
     (R (CoDomain (QName -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> Warning
UselessInline Int32
a
    [Int32
5, Int32
a]               -> (Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Doc -> Warning)))
     (R (CoDomain (Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Doc -> Warning
GenericWarning Int32
a
    [Int32
6, Int32
a, Int32
b, Int32
c]         -> (String -> String -> String -> Warning)
-> Arrows
     (Constant Int32 (Domains (String -> String -> String -> Warning)))
     (R (CoDomain (String -> String -> String -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> String -> String -> Warning
DeprecationWarning Int32
a Int32
b Int32
c
    [Int32
7, Int32
a]               -> (DeclarationWarning -> Warning)
-> Arrows
     (Constant Int32 (Domains (DeclarationWarning -> Warning)))
     (R (CoDomain (DeclarationWarning -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN DeclarationWarning -> Warning
NicifierIssue Int32
a
    [Int32
8, Int32
a]               -> (QName -> Warning)
-> Arrows
     (Constant Int32 (Domains (QName -> Warning)))
     (R (CoDomain (QName -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> Warning
InversionDepthReached Int32
a
    [Int32
9, Int32
a]               -> (Text -> Warning)
-> Arrows
     (Constant Int32 (Domains (Text -> Warning)))
     (R (CoDomain (Text -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Text -> Warning
UserWarning Int32
a
    [Int32
10, Int32
a]              -> ([NamedArg DeBruijnPattern] -> Warning)
-> Arrows
     (Constant Int32 (Domains ([NamedArg DeBruijnPattern] -> Warning)))
     (R (CoDomain ([NamedArg DeBruijnPattern] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [NamedArg DeBruijnPattern] -> Warning
AbsurdPatternRequiresNoRHS Int32
a
    [Int32
11, Int32
a, Int32
b, Int32
c, Int32
d]     -> (QName -> [Name] -> [Name] -> [ImportedName] -> Warning)
-> Arrows
     (Constant
        Int32
        (Domains (QName -> [Name] -> [Name] -> [ImportedName] -> Warning)))
     (R (CoDomain
           (QName -> [Name] -> [Name] -> [ImportedName] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> [Name] -> [Name] -> [ImportedName] -> Warning
ModuleDoesntExport Int32
a Int32
b Int32
c Int32
d
    [Int32
12, Int32
a]              -> (LibWarning -> Warning)
-> Arrows
     (Constant Int32 (Domains (LibWarning -> Warning)))
     (R (CoDomain (LibWarning -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN LibWarning -> Warning
LibraryWarning Int32
a
    [Int32
13, Int32
a, Int32
b]           -> (QName -> [Clause] -> Warning)
-> Arrows
     (Constant Int32 (Domains (QName -> [Clause] -> Warning)))
     (R (CoDomain (QName -> [Clause] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> [Clause] -> Warning
CoverageNoExactSplit Int32
a Int32
b
    [Int32
14, Int32
a]              -> ([MetaId] -> Warning)
-> Arrows
     (Constant Int32 (Domains ([MetaId] -> Warning)))
     (R (CoDomain ([MetaId] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [MetaId] -> Warning
CantGeneralizeOverSorts Int32
a
    [Int32
15, Int32
a]              -> (String -> Warning)
-> Arrows
     (Constant Int32 (Domains (String -> Warning)))
     (R (CoDomain (String -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> Warning
IllformedAsClause Int32
a
    [Int32
16]                 -> Warning
-> Arrows (Constant Int32 (Domains Warning)) (R (CoDomain Warning))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Warning
WithoutKFlagPrimEraseEquality
    [Int32
17, Int32
a]              -> (QName -> Warning)
-> Arrows
     (Constant Int32 (Domains (QName -> Warning)))
     (R (CoDomain (QName -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> Warning
InstanceWithExplicitArg Int32
a
    [Int32
18, Int32
a]              -> (Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Doc -> Warning)))
     (R (CoDomain (Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Doc -> Warning
InfectiveImport Int32
a
    [Int32
19, Int32
a]              -> (Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Doc -> Warning)))
     (R (CoDomain (Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Doc -> Warning
CoInfectiveImport Int32
a
    [Int32
20, Int32
a]              -> (Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Doc -> Warning)))
     (R (CoDomain (Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Doc -> Warning
InstanceNoOutputTypeName Int32
a
    [Int32
21, Int32
a]              -> (Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Doc -> Warning)))
     (R (CoDomain (Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Doc -> Warning
InstanceArgWithExplicitArg Int32
a
    [Int32
22]                 -> Warning
-> Arrows (Constant Int32 (Domains Warning)) (R (CoDomain Warning))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Warning
WrongInstanceDeclaration
    [Int32
23, Int32
a, Int32
b, Int32
c, Int32
d]     -> (Term -> Term -> Term -> Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Term -> Term -> Term -> Doc -> Warning)))
     (R (CoDomain (Term -> Term -> Term -> Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Term -> Term -> Term -> Doc -> Warning
RewriteNonConfluent Int32
a Int32
b Int32
c Int32
d
    [Int32
24, Int32
a, Int32
b, Int32
c]        -> (Term -> Term -> [Doc] -> Warning)
-> Arrows
     (Constant Int32 (Domains (Term -> Term -> [Doc] -> Warning)))
     (R (CoDomain (Term -> Term -> [Doc] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Term -> Term -> [Doc] -> Warning
RewriteMaybeNonConfluent Int32
a Int32
b Int32
c
    [Int32
25, Int32
a, Int32
b]           -> (String -> QName -> Warning)
-> Arrows
     (Constant Int32 (Domains (String -> QName -> Warning)))
     (R (CoDomain (String -> QName -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> QName -> Warning
PragmaCompileErased Int32
a Int32
b
    [Int32
26, Int32
a]              -> (List1 Range -> Warning)
-> Arrows
     (Constant Int32 (Domains (List1 Range -> Warning)))
     (R (CoDomain (List1 Range -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN List1 Range -> Warning
FixityInRenamingModule Int32
a
    [Int32
27, Int32
ns]             -> ([QName] -> Warning)
-> Arrows
     (Constant Int32 (Domains ([QName] -> Warning)))
     (R (CoDomain ([QName] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [QName] -> Warning
NotInScopeW Int32
ns
    [Int32
28, Int32
a, Int32
b]           -> (NameOrModule -> [Name] -> Warning)
-> Arrows
     (Constant Int32 (Domains (NameOrModule -> [Name] -> Warning)))
     (R (CoDomain (NameOrModule -> [Name] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN NameOrModule -> [Name] -> Warning
ClashesViaRenaming Int32
a Int32
b
    [Int32
29, Int32
a]              -> (RecordFieldWarning -> Warning)
-> Arrows
     (Constant Int32 (Domains (RecordFieldWarning -> Warning)))
     (R (CoDomain (RecordFieldWarning -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN RecordFieldWarning -> Warning
RecordFieldWarning Int32
a
    [Int32
30, Int32
a]              -> (String -> Warning)
-> Arrows
     (Constant Int32 (Domains (String -> Warning)))
     (R (CoDomain (String -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> Warning
UselessPatternDeclarationForRecord Int32
a
    [Int32
31]                 -> Warning
-> Arrows (Constant Int32 (Domains Warning)) (R (CoDomain Warning))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Warning
EmptyWhere
    [Int32
32, Int32
a]              -> (Bool -> Warning)
-> Arrows
     (Constant Int32 (Domains (Bool -> Warning)))
     (R (CoDomain (Bool -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Bool -> Warning
AsPatternShadowsConstructorOrPatternSynonym Int32
a
    [Int32
33, Int32
a]              -> (List1 ImportedName -> Warning)
-> Arrows
     (Constant Int32 (Domains (List1 ImportedName -> Warning)))
     (R (CoDomain (List1 ImportedName -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN List1 ImportedName -> Warning
DuplicateUsing Int32
a
    [Int32
34, Int32
a]              -> ([ImportedName] -> Warning)
-> Arrows
     (Constant Int32 (Domains ([ImportedName] -> Warning)))
     (R (CoDomain ([ImportedName] -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [ImportedName] -> Warning
UselessHiding Int32
a
    [Int32
35, Int32
a, Int32
b]           -> (Range -> Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Range -> Doc -> Warning)))
     (R (CoDomain (Range -> Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> Doc -> Warning
GenericUseless Int32
a Int32
b
    [Int32
36, Int32
a, Int32
b, Int32
c]        -> (Term -> Term -> Term -> Warning)
-> Arrows
     (Constant Int32 (Domains (Term -> Term -> Term -> Warning)))
     (R (CoDomain (Term -> Term -> Term -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Term -> Term -> Term -> Warning
RewriteAmbiguousRules Int32
a Int32
b Int32
c
    [Int32
37, Int32
a, Int32
b, Int32
c]        -> (Term -> Term -> Term -> Warning)
-> Arrows
     (Constant Int32 (Domains (Term -> Term -> Term -> Warning)))
     (R (CoDomain (Term -> Term -> Term -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Term -> Term -> Term -> Warning
RewriteMissingRule Int32
a Int32
b Int32
c
    [Int32
38, Int32
a]              -> (ParseWarning -> Warning)
-> Arrows
     (Constant Int32 (Domains (ParseWarning -> Warning)))
     (R (CoDomain (ParseWarning -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN ParseWarning -> Warning
ParseWarning Int32
a
    [Int32
39, Int32
a]              -> (QName -> Warning)
-> Arrows
     (Constant Int32 (Domains (QName -> Warning)))
     (R (CoDomain (QName -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> Warning
NoGuardednessFlag Int32
a
    [Int32
40, Int32
a]              -> (Doc -> Warning)
-> Arrows
     (Constant Int32 (Domains (Doc -> Warning)))
     (R (CoDomain (Doc -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Doc -> Warning
UnsupportedIndexedMatch Int32
a
    [Int32
41, Int32
a]              -> (OptionWarning -> Warning)
-> Arrows
     (Constant Int32 (Domains (OptionWarning -> Warning)))
     (R (CoDomain (OptionWarning -> Warning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN OptionWarning -> Warning
OptionWarning Int32
a
    Node
_ -> R Warning
forall a. R a
malformed

instance EmbPrj OptionWarning where
  icod_ :: OptionWarning -> S Int32
icod_ = \case
    OptionRenamed String
a String
b -> (String -> String -> OptionWarning)
-> Arrows (Domains (String -> String -> OptionWarning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' String -> String -> OptionWarning
OptionRenamed String
a String
b

  value :: Int32 -> R OptionWarning
value = (Node -> R OptionWarning) -> Int32 -> R OptionWarning
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R OptionWarning) -> Int32 -> R OptionWarning)
-> (Node -> R OptionWarning) -> Int32 -> R OptionWarning
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
a, Int32
b] -> (String -> String -> OptionWarning)
-> Arrows
     (Constant Int32 (Domains (String -> String -> OptionWarning)))
     (R (CoDomain (String -> String -> OptionWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> String -> OptionWarning
OptionRenamed Int32
a Int32
b
    Node
_ -> R OptionWarning
forall a. R a
malformed

instance EmbPrj ParseWarning where
  icod_ :: ParseWarning -> S Int32
icod_ = \case
    OverlappingTokensWarning Range
a -> Int32
-> (Range -> ParseWarning)
-> Arrows (Domains (Range -> ParseWarning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Range -> ParseWarning
OverlappingTokensWarning Range
a
    UnsupportedAttribute Range
a Maybe String
b   -> Int32
-> (Range -> Maybe String -> ParseWarning)
-> Arrows
     (Domains (Range -> Maybe String -> ParseWarning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Range -> Maybe String -> ParseWarning
UnsupportedAttribute Range
a Maybe String
b
    MultipleAttributes Range
a Maybe String
b     -> Int32
-> (Range -> Maybe String -> ParseWarning)
-> Arrows
     (Domains (Range -> Maybe String -> ParseWarning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 Range -> Maybe String -> ParseWarning
MultipleAttributes Range
a Maybe String
b

  value :: Int32 -> R ParseWarning
value = (Node -> R ParseWarning) -> Int32 -> R ParseWarning
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R ParseWarning) -> Int32 -> R ParseWarning)
-> (Node -> R ParseWarning) -> Int32 -> R ParseWarning
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a]    -> (Range -> ParseWarning)
-> Arrows
     (Constant Int32 (Domains (Range -> ParseWarning)))
     (R (CoDomain (Range -> ParseWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> ParseWarning
OverlappingTokensWarning Int32
a
    [Int32
1, Int32
a, Int32
b] -> (Range -> Maybe String -> ParseWarning)
-> Arrows
     (Constant Int32 (Domains (Range -> Maybe String -> ParseWarning)))
     (R (CoDomain (Range -> Maybe String -> ParseWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> Maybe String -> ParseWarning
UnsupportedAttribute Int32
a Int32
b
    [Int32
2, Int32
a, Int32
b] -> (Range -> Maybe String -> ParseWarning)
-> Arrows
     (Constant Int32 (Domains (Range -> Maybe String -> ParseWarning)))
     (R (CoDomain (Range -> Maybe String -> ParseWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> Maybe String -> ParseWarning
MultipleAttributes Int32
a Int32
b
    Node
_ -> R ParseWarning
forall a. R a
malformed

instance EmbPrj RecordFieldWarning where
  icod_ :: RecordFieldWarning -> S Int32
icod_ = \case
    DuplicateFieldsWarning [(Name, Range)]
a   -> Int32
-> ([(Name, Range)] -> RecordFieldWarning)
-> Arrows
     (Domains ([(Name, Range)] -> RecordFieldWarning)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 [(Name, Range)] -> RecordFieldWarning
DuplicateFieldsWarning [(Name, Range)]
a
    TooManyFieldsWarning QName
a [Name]
b [(Name, Range)]
c -> Int32
-> (QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning)
-> Arrows
     (Domains
        (QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning
TooManyFieldsWarning QName
a [Name]
b [(Name, Range)]
c

  value :: Int32 -> R RecordFieldWarning
value = (Node -> R RecordFieldWarning) -> Int32 -> R RecordFieldWarning
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R RecordFieldWarning) -> Int32 -> R RecordFieldWarning)
-> (Node -> R RecordFieldWarning) -> Int32 -> R RecordFieldWarning
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a]       -> ([(Name, Range)] -> RecordFieldWarning)
-> Arrows
     (Constant Int32 (Domains ([(Name, Range)] -> RecordFieldWarning)))
     (R (CoDomain ([(Name, Range)] -> RecordFieldWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [(Name, Range)] -> RecordFieldWarning
DuplicateFieldsWarning Int32
a
    [Int32
1, Int32
a, Int32
b, Int32
c] -> (QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning)
-> Arrows
     (Constant
        Int32
        (Domains
           (QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning)))
     (R (CoDomain
           (QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> [Name] -> [(Name, Range)] -> RecordFieldWarning
TooManyFieldsWarning Int32
a Int32
b Int32
c
    Node
_ -> R RecordFieldWarning
forall a. R a
malformed

instance EmbPrj DeclarationWarning where
  icod_ :: DeclarationWarning -> S Int32
icod_ (DeclarationWarning CallStack
a DeclarationWarning'
b) = (CallStack -> DeclarationWarning' -> DeclarationWarning)
-> Arrows
     (Domains (CallStack -> DeclarationWarning' -> DeclarationWarning))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' CallStack -> DeclarationWarning' -> DeclarationWarning
DeclarationWarning CallStack
a DeclarationWarning'
b
  value :: Int32 -> R DeclarationWarning
value = (Node -> R DeclarationWarning) -> Int32 -> R DeclarationWarning
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R DeclarationWarning) -> Int32 -> R DeclarationWarning)
-> (Node -> R DeclarationWarning) -> Int32 -> R DeclarationWarning
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
a, Int32
b] -> (CallStack -> DeclarationWarning' -> DeclarationWarning)
-> Arrows
     (Constant
        Int32
        (Domains (CallStack -> DeclarationWarning' -> DeclarationWarning)))
     (R (CoDomain
           (CallStack -> DeclarationWarning' -> DeclarationWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN CallStack -> DeclarationWarning' -> DeclarationWarning
DeclarationWarning Int32
a Int32
b
    Node
_ -> R DeclarationWarning
forall a. R a
malformed

instance EmbPrj DeclarationWarning' where
  icod_ :: DeclarationWarning' -> S Int32
icod_ = \case
    UnknownNamesInFixityDecl [Name]
a        -> Int32
-> ([Name] -> DeclarationWarning')
-> Arrows (Domains ([Name] -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 [Name] -> DeclarationWarning'
UnknownNamesInFixityDecl [Name]
a
    UnknownNamesInPolarityPragmas [Name]
a   -> Int32
-> ([Name] -> DeclarationWarning')
-> Arrows (Domains ([Name] -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 [Name] -> DeclarationWarning'
UnknownNamesInPolarityPragmas [Name]
a
    PolarityPragmasButNotPostulates [Name]
a -> Int32
-> ([Name] -> DeclarationWarning')
-> Arrows (Domains ([Name] -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 [Name] -> DeclarationWarning'
PolarityPragmasButNotPostulates [Name]
a
    UselessPrivate Range
a                  -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
3 Range -> DeclarationWarning'
UselessPrivate Range
a
    UselessAbstract Range
a                 -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
4 Range -> DeclarationWarning'
UselessAbstract Range
a
    UselessInstance Range
a                 -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
5 Range -> DeclarationWarning'
UselessInstance Range
a
    EmptyMutual Range
a                     -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
6 Range -> DeclarationWarning'
EmptyMutual Range
a
    EmptyAbstract Range
a                   -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
7 Range -> DeclarationWarning'
EmptyAbstract Range
a
    EmptyPrivate Range
a                    -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
8 Range -> DeclarationWarning'
EmptyPrivate Range
a
    EmptyInstance Range
a                   -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
9 Range -> DeclarationWarning'
EmptyInstance Range
a
    EmptyMacro Range
a                      -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
10 Range -> DeclarationWarning'
EmptyMacro Range
a
    EmptyPostulate Range
a                  -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
11 Range -> DeclarationWarning'
EmptyPostulate Range
a
    InvalidTerminationCheckPragma Range
a   -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
12 Range -> DeclarationWarning'
InvalidTerminationCheckPragma Range
a
    InvalidNoPositivityCheckPragma Range
a  -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
13 Range -> DeclarationWarning'
InvalidNoPositivityCheckPragma Range
a
    InvalidCatchallPragma Range
a           -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
14 Range -> DeclarationWarning'
InvalidCatchallPragma Range
a
    InvalidNoUniverseCheckPragma Range
a    -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
15 Range -> DeclarationWarning'
InvalidNoUniverseCheckPragma Range
a
    UnknownFixityInMixfixDecl [Name]
a       -> Int32
-> ([Name] -> DeclarationWarning')
-> Arrows (Domains ([Name] -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
16 [Name] -> DeclarationWarning'
UnknownFixityInMixfixDecl [Name]
a
    MissingDefinitions [(Name, Range)]
a              -> Int32
-> ([(Name, Range)] -> DeclarationWarning')
-> Arrows
     (Domains ([(Name, Range)] -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
17 [(Name, Range)] -> DeclarationWarning'
MissingDefinitions [(Name, Range)]
a
    NotAllowedInMutual Range
r String
a            -> Int32
-> (Range -> String -> DeclarationWarning')
-> Arrows
     (Domains (Range -> String -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
18 Range -> String -> DeclarationWarning'
NotAllowedInMutual Range
r String
a
    PragmaNoTerminationCheck Range
r        -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
19 Range -> DeclarationWarning'
PragmaNoTerminationCheck Range
r
    EmptyGeneralize Range
a                 -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
20 Range -> DeclarationWarning'
EmptyGeneralize Range
a
    PragmaCompiled Range
r                  -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
21 Range -> DeclarationWarning'
PragmaCompiled Range
r
    EmptyPrimitive Range
a                  -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
22 Range -> DeclarationWarning'
EmptyPrimitive Range
a
    EmptyField Range
r                      -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
23 Range -> DeclarationWarning'
EmptyField Range
r
    ShadowingInTelescope List1 (Name, List2 Range)
nrs          -> Int32
-> (List1 (Name, List2 Range) -> DeclarationWarning')
-> Arrows
     (Domains (List1 (Name, List2 Range) -> DeclarationWarning'))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
24 List1 (Name, List2 Range) -> DeclarationWarning'
ShadowingInTelescope List1 (Name, List2 Range)
nrs
    InvalidCoverageCheckPragma Range
r      -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
25 Range -> DeclarationWarning'
InvalidCoverageCheckPragma Range
r
    OpenPublicAbstract Range
r              -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
26 Range -> DeclarationWarning'
OpenPublicAbstract Range
r
    OpenPublicPrivate Range
r               -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
27 Range -> DeclarationWarning'
OpenPublicPrivate Range
r
    EmptyConstructor Range
a                -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
28 Range -> DeclarationWarning'
EmptyConstructor Range
a
    InvalidRecordDirective Range
a          -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
29 Range -> DeclarationWarning'
InvalidRecordDirective Range
a
    InvalidConstructor Range
a              -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
30 Range -> DeclarationWarning'
InvalidConstructor Range
a
    InvalidConstructorBlock Range
a         -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
31 Range -> DeclarationWarning'
InvalidConstructorBlock Range
a
    MissingDeclarations [(Name, Range)]
a             -> Int32
-> ([(Name, Range)] -> DeclarationWarning')
-> Arrows
     (Domains ([(Name, Range)] -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
32 [(Name, Range)] -> DeclarationWarning'
MissingDeclarations [(Name, Range)]
a
    HiddenGeneralize Range
r                -> Int32
-> (Range -> DeclarationWarning')
-> Arrows (Domains (Range -> DeclarationWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
33 Range -> DeclarationWarning'
HiddenGeneralize Range
r

  value :: Int32 -> R DeclarationWarning'
value = (Node -> R DeclarationWarning') -> Int32 -> R DeclarationWarning'
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R DeclarationWarning') -> Int32 -> R DeclarationWarning')
-> (Node -> R DeclarationWarning')
-> Int32
-> R DeclarationWarning'
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a]   -> ([Name] -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains ([Name] -> DeclarationWarning')))
     (R (CoDomain ([Name] -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [Name] -> DeclarationWarning'
UnknownNamesInFixityDecl Int32
a
    [Int32
1, Int32
a]   -> ([Name] -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains ([Name] -> DeclarationWarning')))
     (R (CoDomain ([Name] -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [Name] -> DeclarationWarning'
UnknownNamesInPolarityPragmas Int32
a
    [Int32
2, Int32
a]   -> ([Name] -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains ([Name] -> DeclarationWarning')))
     (R (CoDomain ([Name] -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [Name] -> DeclarationWarning'
PolarityPragmasButNotPostulates Int32
a
    [Int32
3, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
UselessPrivate Int32
a
    [Int32
4, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
UselessAbstract Int32
a
    [Int32
5, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
UselessInstance Int32
a
    [Int32
6, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyMutual Int32
a
    [Int32
7, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyAbstract Int32
a
    [Int32
8, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyPrivate Int32
a
    [Int32
9, Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyInstance Int32
a
    [Int32
10,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyMacro Int32
a
    [Int32
11,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyPostulate Int32
a
    [Int32
12,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidTerminationCheckPragma Int32
a
    [Int32
13,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidNoPositivityCheckPragma Int32
a
    [Int32
14,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidCatchallPragma Int32
a
    [Int32
15,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidNoUniverseCheckPragma Int32
a
    [Int32
16,Int32
a]   -> ([Name] -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains ([Name] -> DeclarationWarning')))
     (R (CoDomain ([Name] -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [Name] -> DeclarationWarning'
UnknownFixityInMixfixDecl Int32
a
    [Int32
17,Int32
a]   -> ([(Name, Range)] -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains ([(Name, Range)] -> DeclarationWarning')))
     (R (CoDomain ([(Name, Range)] -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [(Name, Range)] -> DeclarationWarning'
MissingDefinitions Int32
a
    [Int32
18,Int32
r,Int32
a] -> (Range -> String -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> String -> DeclarationWarning')))
     (R (CoDomain (Range -> String -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> String -> DeclarationWarning'
NotAllowedInMutual Int32
r Int32
a
    [Int32
19,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
PragmaNoTerminationCheck Int32
r
    [Int32
20,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyGeneralize Int32
a
    [Int32
21,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
PragmaCompiled Int32
a
    [Int32
22,Int32
a]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyPrimitive Int32
a
    [Int32
23,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyField Int32
r
    [Int32
24,Int32
nrs] -> (List1 (Name, List2 Range) -> DeclarationWarning')
-> Arrows
     (Constant
        Int32 (Domains (List1 (Name, List2 Range) -> DeclarationWarning')))
     (R (CoDomain (List1 (Name, List2 Range) -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN List1 (Name, List2 Range) -> DeclarationWarning'
ShadowingInTelescope Int32
nrs
    [Int32
25,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidCoverageCheckPragma Int32
r
    [Int32
26,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
OpenPublicAbstract Int32
r
    [Int32
27,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
OpenPublicPrivate Int32
r
    [Int32
28,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
EmptyConstructor Int32
r
    [Int32
29,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidRecordDirective Int32
r
    [Int32
30,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidConstructor Int32
r
    [Int32
31,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
InvalidConstructorBlock Int32
r
    [Int32
32,Int32
r]   -> ([(Name, Range)] -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains ([(Name, Range)] -> DeclarationWarning')))
     (R (CoDomain ([(Name, Range)] -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [(Name, Range)] -> DeclarationWarning'
MissingDeclarations Int32
r
    [Int32
33,Int32
r]   -> (Range -> DeclarationWarning')
-> Arrows
     (Constant Int32 (Domains (Range -> DeclarationWarning')))
     (R (CoDomain (Range -> DeclarationWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> DeclarationWarning'
HiddenGeneralize Int32
r
    Node
_ -> R DeclarationWarning'
forall a. R a
malformed

instance EmbPrj LibWarning where
  icod_ :: LibWarning -> S Int32
icod_ = \case
    LibWarning Maybe LibPositionInfo
a LibWarning'
b -> Int32
-> (Maybe LibPositionInfo -> LibWarning' -> LibWarning)
-> Arrows
     (Domains (Maybe LibPositionInfo -> LibWarning' -> LibWarning))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Maybe LibPositionInfo -> LibWarning' -> LibWarning
LibWarning Maybe LibPositionInfo
a LibWarning'
b

  value :: Int32 -> R LibWarning
value = (Node -> R LibWarning) -> Int32 -> R LibWarning
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R LibWarning) -> Int32 -> R LibWarning)
-> (Node -> R LibWarning) -> Int32 -> R LibWarning
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a, Int32
b]   -> (Maybe LibPositionInfo -> LibWarning' -> LibWarning)
-> Arrows
     (Constant
        Int32
        (Domains (Maybe LibPositionInfo -> LibWarning' -> LibWarning)))
     (R (CoDomain (Maybe LibPositionInfo -> LibWarning' -> LibWarning)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Maybe LibPositionInfo -> LibWarning' -> LibWarning
LibWarning Int32
a Int32
b
    Node
_ -> R LibWarning
forall a. R a
malformed

instance EmbPrj LibWarning' where
  icod_ :: LibWarning' -> S Int32
icod_ = \case
    UnknownField     String
a   -> Int32
-> (String -> LibWarning')
-> Arrows (Domains (String -> LibWarning')) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 String -> LibWarning'
UnknownField String
a

  value :: Int32 -> R LibWarning'
value = (Node -> R LibWarning') -> Int32 -> R LibWarning'
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R LibWarning') -> Int32 -> R LibWarning')
-> (Node -> R LibWarning') -> Int32 -> R LibWarning'
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a]    -> (String -> LibWarning')
-> Arrows
     (Constant Int32 (Domains (String -> LibWarning')))
     (R (CoDomain (String -> LibWarning')))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> LibWarning'
UnknownField Int32
a
    Node
_ -> R LibWarning'
forall a. R a
malformed

instance EmbPrj ExecutablesFile where
  icod_ :: ExecutablesFile -> S Int32
icod_ = \case
    ExecutablesFile String
a Bool
b -> Int32
-> (String -> Bool -> ExecutablesFile)
-> Arrows (Domains (String -> Bool -> ExecutablesFile)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 String -> Bool -> ExecutablesFile
ExecutablesFile String
a Bool
b

  value :: Int32 -> R ExecutablesFile
value = (Node -> R ExecutablesFile) -> Int32 -> R ExecutablesFile
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R ExecutablesFile) -> Int32 -> R ExecutablesFile)
-> (Node -> R ExecutablesFile) -> Int32 -> R ExecutablesFile
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a, Int32
b] -> (String -> Bool -> ExecutablesFile)
-> Arrows
     (Constant Int32 (Domains (String -> Bool -> ExecutablesFile)))
     (R (CoDomain (String -> Bool -> ExecutablesFile)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> Bool -> ExecutablesFile
ExecutablesFile Int32
a Int32
b
    Node
_ -> R ExecutablesFile
forall a. R a
malformed

instance EmbPrj LibPositionInfo where
  icod_ :: LibPositionInfo -> S Int32
icod_ = \case
    LibPositionInfo Maybe String
a LineNumber
b String
c -> Int32
-> (Maybe String -> LineNumber -> String -> LibPositionInfo)
-> Arrows
     (Domains (Maybe String -> LineNumber -> String -> LibPositionInfo))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Maybe String -> LineNumber -> String -> LibPositionInfo
LibPositionInfo Maybe String
a LineNumber
b String
c

  value :: Int32 -> R LibPositionInfo
value = (Node -> R LibPositionInfo) -> Int32 -> R LibPositionInfo
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R LibPositionInfo) -> Int32 -> R LibPositionInfo)
-> (Node -> R LibPositionInfo) -> Int32 -> R LibPositionInfo
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a, Int32
b, Int32
c] -> (Maybe String -> LineNumber -> String -> LibPositionInfo)
-> Arrows
     (Constant
        Int32
        (Domains
           (Maybe String -> LineNumber -> String -> LibPositionInfo)))
     (R (CoDomain
           (Maybe String -> LineNumber -> String -> LibPositionInfo)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Maybe String -> LineNumber -> String -> LibPositionInfo
LibPositionInfo Int32
a Int32
b Int32
c
    Node
_ -> R LibPositionInfo
forall a. R a
malformed

instance EmbPrj Doc where
  icod_ :: Doc -> S Int32
icod_ Doc
d = (String -> Doc) -> Arrows (Domains (String -> Doc)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' (String -> Doc
forall a. HasCallStack => a
undefined :: String -> Doc) (Doc -> String
render Doc
d)

  value :: Int32 -> R Doc
value = (String -> Doc) -> Int32 -> R (CoDomain (String -> Doc))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN String -> Doc
text

instance EmbPrj InfectiveCoinfective where
  icod_ :: InfectiveCoinfective -> S Int32
icod_ InfectiveCoinfective
Infective   = InfectiveCoinfective
-> Arrows (Domains InfectiveCoinfective) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' InfectiveCoinfective
Infective
  icod_ InfectiveCoinfective
Coinfective = Int32
-> InfectiveCoinfective
-> Arrows (Domains InfectiveCoinfective) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 InfectiveCoinfective
Coinfective

  value :: Int32 -> R InfectiveCoinfective
value = (Node -> R InfectiveCoinfective) -> Int32 -> R InfectiveCoinfective
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase Node -> R InfectiveCoinfective
forall {a}. (Eq a, Num a) => [a] -> R InfectiveCoinfective
valu where
    valu :: [a]
-> Arrows
     (Constant Int32 (Domains InfectiveCoinfective))
     (R (CoDomain InfectiveCoinfective))
valu []  = InfectiveCoinfective
-> Arrows
     (Constant Int32 (Domains InfectiveCoinfective))
     (R (CoDomain InfectiveCoinfective))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN InfectiveCoinfective
Infective
    valu [a
0] = InfectiveCoinfective
-> Arrows
     (Constant Int32 (Domains InfectiveCoinfective))
     (R (CoDomain InfectiveCoinfective))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN InfectiveCoinfective
Coinfective
    valu [a]
_   = R InfectiveCoinfective
Arrows
  (Constant Int32 (Domains InfectiveCoinfective))
  (R (CoDomain InfectiveCoinfective))
forall a. R a
malformed

instance EmbPrj PragmaOptions where
  icod_ :: PragmaOptions -> S Int32
icod_ = \case
    PragmaOptions Bool
a Bool
b UnicodeOrAscii
c Verbosity
d ProfileOptions
e Bool
f WithDefault 'False
g Bool
h Bool
i Bool
j Bool
k CutOff
l Bool
m Bool
n Bool
o WithDefault 'False
p WithDefault 'False
q Bool
r Bool
s Bool
t Bool
u WithDefault 'False
v WithDefault 'False
w Bool
x Bool
y Bool
z Bool
aa Bool
bb Bool
cc Bool
dd Bool
ee Maybe Cubical
ff Bool
gg Bool
hh Bool
ii Bool
jj LineNumber
kk Bool
ll Bool
mm LineNumber
nn Bool
oo Bool
pp Maybe LineNumber
qq WarningMode
rr Bool
ss Bool
tt Bool
uu Bool
vv Bool
ww Bool
xx Bool
yy Maybe ConfluenceCheck
zz Bool
aaa WithDefault 'False
bbb Bool
ccc Bool
ddd Bool
eee WithDefault 'False
fff Bool
ggg Bool
hhh ->
      (Bool
 -> Bool
 -> UnicodeOrAscii
 -> Verbosity
 -> ProfileOptions
 -> Bool
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> CutOff
 -> Bool
 -> Bool
 -> Bool
 -> WithDefault 'False
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> WithDefault 'False
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Maybe Cubical
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> LineNumber
 -> Bool
 -> Bool
 -> LineNumber
 -> Bool
 -> Bool
 -> Maybe LineNumber
 -> WarningMode
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Maybe ConfluenceCheck
 -> Bool
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> PragmaOptions)
-> Arrows
     (Domains
        (Bool
         -> Bool
         -> UnicodeOrAscii
         -> Verbosity
         -> ProfileOptions
         -> Bool
         -> WithDefault 'False
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> CutOff
         -> Bool
         -> Bool
         -> Bool
         -> WithDefault 'False
         -> WithDefault 'False
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> WithDefault 'False
         -> WithDefault 'False
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Maybe Cubical
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> LineNumber
         -> Bool
         -> Bool
         -> LineNumber
         -> Bool
         -> Bool
         -> Maybe LineNumber
         -> WarningMode
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Bool
         -> Maybe ConfluenceCheck
         -> Bool
         -> WithDefault 'False
         -> Bool
         -> Bool
         -> Bool
         -> WithDefault 'False
         -> Bool
         -> Bool
         -> PragmaOptions))
     (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Bool
-> Bool
-> UnicodeOrAscii
-> Verbosity
-> ProfileOptions
-> Bool
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> Bool
-> CutOff
-> Bool
-> Bool
-> Bool
-> WithDefault 'False
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> Bool
-> WithDefault 'False
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Cubical
-> Bool
-> Bool
-> Bool
-> Bool
-> LineNumber
-> Bool
-> Bool
-> LineNumber
-> Bool
-> Bool
-> Maybe LineNumber
-> WarningMode
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe ConfluenceCheck
-> Bool
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> WithDefault 'False
-> Bool
-> Bool
-> PragmaOptions
PragmaOptions Bool
a Bool
b UnicodeOrAscii
c Verbosity
d ProfileOptions
e Bool
f WithDefault 'False
g Bool
h Bool
i Bool
j Bool
k CutOff
l Bool
m Bool
n Bool
o WithDefault 'False
p WithDefault 'False
q Bool
r Bool
s Bool
t Bool
u WithDefault 'False
v WithDefault 'False
w Bool
x Bool
y Bool
z Bool
aa Bool
bb Bool
cc Bool
dd Bool
ee Maybe Cubical
ff Bool
gg Bool
hh Bool
ii Bool
jj LineNumber
kk Bool
ll Bool
mm LineNumber
nn Bool
oo Bool
pp Maybe LineNumber
qq WarningMode
rr Bool
ss Bool
tt Bool
uu Bool
vv Bool
ww Bool
xx Bool
yy Maybe ConfluenceCheck
zz Bool
aaa WithDefault 'False
bbb Bool
ccc Bool
ddd Bool
eee WithDefault 'False
fff Bool
ggg Bool
hhh

  value :: Int32 -> R PragmaOptions
value = (Node -> R PragmaOptions) -> Int32 -> R PragmaOptions
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R PragmaOptions) -> Int32 -> R PragmaOptions)
-> (Node -> R PragmaOptions) -> Int32 -> R PragmaOptions
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
a, Int32
b, Int32
c, Int32
d, Int32
e, Int32
f, Int32
g, Int32
h, Int32
i, Int32
j, Int32
k, Int32
l, Int32
m, Int32
n, Int32
o, Int32
p, Int32
q, Int32
r, Int32
s, Int32
t, Int32
u, Int32
v, Int32
w, Int32
x, Int32
y, Int32
z, Int32
aa, Int32
bb, Int32
cc, Int32
dd, Int32
ee, Int32
ff, Int32
gg, Int32
hh, Int32
ii, Int32
jj, Int32
kk, Int32
ll, Int32
mm, Int32
nn, Int32
oo, Int32
pp, Int32
qq, Int32
rr, Int32
ss, Int32
tt, Int32
uu, Int32
vv, Int32
ww, Int32
xx, Int32
yy, Int32
zz, Int32
aaa, Int32
bbb, Int32
ccc, Int32
ddd, Int32
eee, Int32
fff, Int32
ggg, Int32
hhh] ->
      (Bool
 -> Bool
 -> UnicodeOrAscii
 -> Verbosity
 -> ProfileOptions
 -> Bool
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> CutOff
 -> Bool
 -> Bool
 -> Bool
 -> WithDefault 'False
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> WithDefault 'False
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Maybe Cubical
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> LineNumber
 -> Bool
 -> Bool
 -> LineNumber
 -> Bool
 -> Bool
 -> Maybe LineNumber
 -> WarningMode
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Maybe ConfluenceCheck
 -> Bool
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> Bool
 -> WithDefault 'False
 -> Bool
 -> Bool
 -> PragmaOptions)
-> Arrows
     (Constant
        Int32
        (Domains
           (Bool
            -> Bool
            -> UnicodeOrAscii
            -> Verbosity
            -> ProfileOptions
            -> Bool
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> CutOff
            -> Bool
            -> Bool
            -> Bool
            -> WithDefault 'False
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> WithDefault 'False
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Maybe Cubical
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> LineNumber
            -> Bool
            -> Bool
            -> LineNumber
            -> Bool
            -> Bool
            -> Maybe LineNumber
            -> WarningMode
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Maybe ConfluenceCheck
            -> Bool
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> PragmaOptions)))
     (R (CoDomain
           (Bool
            -> Bool
            -> UnicodeOrAscii
            -> Verbosity
            -> ProfileOptions
            -> Bool
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> CutOff
            -> Bool
            -> Bool
            -> Bool
            -> WithDefault 'False
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> WithDefault 'False
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Maybe Cubical
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> LineNumber
            -> Bool
            -> Bool
            -> LineNumber
            -> Bool
            -> Bool
            -> Maybe LineNumber
            -> WarningMode
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Bool
            -> Maybe ConfluenceCheck
            -> Bool
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> Bool
            -> WithDefault 'False
            -> Bool
            -> Bool
            -> PragmaOptions)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Bool
-> Bool
-> UnicodeOrAscii
-> Verbosity
-> ProfileOptions
-> Bool
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> Bool
-> CutOff
-> Bool
-> Bool
-> Bool
-> WithDefault 'False
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> Bool
-> WithDefault 'False
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Cubical
-> Bool
-> Bool
-> Bool
-> Bool
-> LineNumber
-> Bool
-> Bool
-> LineNumber
-> Bool
-> Bool
-> Maybe LineNumber
-> WarningMode
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe ConfluenceCheck
-> Bool
-> WithDefault 'False
-> Bool
-> Bool
-> Bool
-> WithDefault 'False
-> Bool
-> Bool
-> PragmaOptions
PragmaOptions Int32
a Int32
b Int32
c Int32
d Int32
e Int32
f Int32
g Int32
h Int32
i Int32
j Int32
k Int32
l Int32
m Int32
n Int32
o Int32
p Int32
q Int32
r Int32
s Int32
t Int32
u Int32
v Int32
w Int32
x Int32
y Int32
z Int32
aa Int32
bb Int32
cc Int32
dd Int32
ee Int32
ff Int32
gg Int32
hh Int32
ii Int32
jj Int32
kk Int32
ll Int32
mm Int32
nn Int32
oo Int32
pp Int32
qq Int32
rr Int32
ss Int32
tt Int32
uu Int32
vv Int32
ww Int32
xx Int32
yy Int32
zz Int32
aaa Int32
bbb Int32
ccc Int32
ddd Int32
eee Int32
fff Int32
ggg Int32
hhh
    Node
_ -> R PragmaOptions
forall a. R a
malformed

instance EmbPrj ProfileOptions where
  icod_ :: ProfileOptions -> S Int32
icod_ ProfileOptions
opts = [ProfileOption] -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (ProfileOptions -> [ProfileOption]
profileOptionsToList ProfileOptions
opts)
  value :: Int32 -> R ProfileOptions
value = ([ProfileOption] -> ProfileOptions)
-> ExceptT TypeError (StateT St IO) [ProfileOption]
-> R ProfileOptions
forall a b.
(a -> b)
-> ExceptT TypeError (StateT St IO) a
-> ExceptT TypeError (StateT St IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ProfileOption] -> ProfileOptions
profileOptionsFromList (ExceptT TypeError (StateT St IO) [ProfileOption]
 -> R ProfileOptions)
-> (Int32 -> ExceptT TypeError (StateT St IO) [ProfileOption])
-> Int32
-> R ProfileOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> ExceptT TypeError (StateT St IO) [ProfileOption]
forall a. EmbPrj a => Int32 -> R a
value

instance EmbPrj ProfileOption where
  icod_ :: ProfileOption -> S Int32
icod_ = LineNumber -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (LineNumber -> S Int32)
-> (ProfileOption -> LineNumber) -> ProfileOption -> S Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfileOption -> LineNumber
forall a. Enum a => a -> LineNumber
fromEnum
  value :: Int32 -> R ProfileOption
value = Int32 -> R LineNumber
forall a. EmbPrj a => Int32 -> R a
value (Int32 -> R LineNumber)
-> (LineNumber -> R ProfileOption) -> Int32 -> R ProfileOption
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ LineNumber
n -> if LineNumber
lo LineNumber -> LineNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= LineNumber
n Bool -> Bool -> Bool
&& LineNumber
n LineNumber -> LineNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= LineNumber
hi then ProfileOption -> R ProfileOption
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LineNumber -> ProfileOption
forall a. Enum a => LineNumber -> a
toEnum LineNumber
n) else R ProfileOption
forall a. R a
malformed
    where
      lo :: LineNumber
lo = ProfileOption -> LineNumber
forall a. Enum a => a -> LineNumber
fromEnum (ProfileOption
forall a. Bounded a => a
minBound :: ProfileOption)
      hi :: LineNumber
hi = ProfileOption -> LineNumber
forall a. Enum a => a -> LineNumber
fromEnum (ProfileOption
forall a. Bounded a => a
maxBound :: ProfileOption)

instance EmbPrj UnicodeOrAscii

instance EmbPrj ConfluenceCheck where
  icod_ :: ConfluenceCheck -> S Int32
icod_ ConfluenceCheck
LocalConfluenceCheck  = ConfluenceCheck -> Arrows (Domains ConfluenceCheck) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' ConfluenceCheck
LocalConfluenceCheck
  icod_ ConfluenceCheck
GlobalConfluenceCheck = Int32
-> ConfluenceCheck -> Arrows (Domains ConfluenceCheck) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 ConfluenceCheck
GlobalConfluenceCheck

  value :: Int32 -> R ConfluenceCheck
value = (Node -> R ConfluenceCheck) -> Int32 -> R ConfluenceCheck
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase Node -> R ConfluenceCheck
forall {a}. (Eq a, Num a) => [a] -> R ConfluenceCheck
valu where
    valu :: [a]
-> Arrows
     (Constant Int32 (Domains ConfluenceCheck))
     (R (CoDomain ConfluenceCheck))
valu []  = ConfluenceCheck
-> Arrows
     (Constant Int32 (Domains ConfluenceCheck))
     (R (CoDomain ConfluenceCheck))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN ConfluenceCheck
LocalConfluenceCheck
    valu [a
0] = ConfluenceCheck
-> Arrows
     (Constant Int32 (Domains ConfluenceCheck))
     (R (CoDomain ConfluenceCheck))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN ConfluenceCheck
GlobalConfluenceCheck
    valu [a]
_   = R ConfluenceCheck
Arrows
  (Constant Int32 (Domains ConfluenceCheck))
  (R (CoDomain ConfluenceCheck))
forall a. R a
malformed

instance EmbPrj WarningMode where
  icod_ :: WarningMode -> S Int32
icod_ = \case
    WarningMode Set WarningName
a Bool
b -> (Set WarningName -> Bool -> WarningMode)
-> Arrows
     (Domains (Set WarningName -> Bool -> WarningMode)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Set WarningName -> Bool -> WarningMode
WarningMode Set WarningName
a Bool
b

  value :: Int32 -> R WarningMode
value = (Node -> R WarningMode) -> Int32 -> R WarningMode
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase ((Node -> R WarningMode) -> Int32 -> R WarningMode)
-> (Node -> R WarningMode) -> Int32 -> R WarningMode
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
a, Int32
b]   -> (Set WarningName -> Bool -> WarningMode)
-> Arrows
     (Constant Int32 (Domains (Set WarningName -> Bool -> WarningMode)))
     (R (CoDomain (Set WarningName -> Bool -> WarningMode)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Set WarningName -> Bool -> WarningMode
WarningMode Int32
a Int32
b
    Node
_ -> R WarningMode
forall a. R a
malformed

instance EmbPrj WarningName where
  icod_ :: WarningName -> S Int32
icod_ = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> S Int32)
-> (WarningName -> Int32) -> WarningName -> S Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    WarningName
OverlappingTokensWarning_                    -> Int32
0
    WarningName
UnsupportedAttribute_                        -> Int32
1
    WarningName
MultipleAttributes_                          -> Int32
2
    WarningName
LibUnknownField_                             -> Int32
3
    WarningName
EmptyAbstract_                               -> Int32
4
    WarningName
EmptyConstructor_                            -> Int32
5
    WarningName
EmptyField_                                  -> Int32
6
    WarningName
EmptyGeneralize_                             -> Int32
7
    WarningName
EmptyInstance_                               -> Int32
8
    WarningName
EmptyMacro_                                  -> Int32
9
    WarningName
EmptyMutual_                                 -> Int32
10
    WarningName
EmptyPostulate_                              -> Int32
11
    WarningName
EmptyPrimitive_                              -> Int32
12
    WarningName
EmptyPrivate_                                -> Int32
13
    WarningName
EmptyRewritePragma_                          -> Int32
14
    WarningName
EmptyWhere_                                  -> Int32
15
    WarningName
HiddenGeneralize_                            -> Int32
16
    WarningName
InvalidCatchallPragma_                       -> Int32
17
    WarningName
InvalidConstructor_                          -> Int32
18
    WarningName
InvalidConstructorBlock_                     -> Int32
19
    WarningName
InvalidCoverageCheckPragma_                  -> Int32
20
    WarningName
InvalidNoPositivityCheckPragma_              -> Int32
21
    WarningName
InvalidNoUniverseCheckPragma_                -> Int32
22
    WarningName
InvalidRecordDirective_                      -> Int32
23
    WarningName
InvalidTerminationCheckPragma_               -> Int32
24
    WarningName
MissingDeclarations_                         -> Int32
25
    WarningName
MissingDefinitions_                          -> Int32
26
    WarningName
NotAllowedInMutual_                          -> Int32
27
    WarningName
OpenPublicAbstract_                          -> Int32
28
    WarningName
OpenPublicPrivate_                           -> Int32
29
    WarningName
PolarityPragmasButNotPostulates_             -> Int32
30
    WarningName
PragmaCompiled_                              -> Int32
31
    WarningName
PragmaNoTerminationCheck_                    -> Int32
32
    WarningName
ShadowingInTelescope_                        -> Int32
33
    WarningName
UnknownFixityInMixfixDecl_                   -> Int32
34
    WarningName
UnknownNamesInFixityDecl_                    -> Int32
35
    WarningName
UnknownNamesInPolarityPragmas_               -> Int32
36
    WarningName
UselessAbstract_                             -> Int32
37
    WarningName
UselessInstance_                             -> Int32
38
    WarningName
UselessPrivate_                              -> Int32
39
    WarningName
AbsurdPatternRequiresNoRHS_                  -> Int32
40
    WarningName
AsPatternShadowsConstructorOrPatternSynonym_ -> Int32
41
    WarningName
CantGeneralizeOverSorts_                     -> Int32
42
    WarningName
ClashesViaRenaming_                          -> Int32
43
    WarningName
CoverageIssue_                               -> Int32
44
    WarningName
CoverageNoExactSplit_                        -> Int32
45
    WarningName
DeprecationWarning_                          -> Int32
46
    WarningName
DuplicateUsing_                              -> Int32
47
    WarningName
FixityInRenamingModule_                      -> Int32
48
    WarningName
GenericNonFatalError_                        -> Int32
49
    WarningName
GenericUseless_                              -> Int32
50
    WarningName
GenericWarning_                              -> Int32
51
    WarningName
IllformedAsClause_                           -> Int32
52
    WarningName
InstanceArgWithExplicitArg_                  -> Int32
53
    WarningName
InstanceWithExplicitArg_                     -> Int32
54
    WarningName
InstanceNoOutputTypeName_                    -> Int32
55
    WarningName
InversionDepthReached_                       -> Int32
56
    WarningName
ModuleDoesntExport_                          -> Int32
57
    WarningName
NoGuardednessFlag_                           -> Int32
58
    WarningName
NotInScope_                                  -> Int32
59
    WarningName
NotStrictlyPositive_                         -> Int32
60
    WarningName
UnsupportedIndexedMatch_                        -> Int32
61
    WarningName
OldBuiltin_                                  -> Int32
62
    WarningName
PragmaCompileErased_                         -> Int32
63
    WarningName
RewriteMaybeNonConfluent_                    -> Int32
64
    WarningName
RewriteNonConfluent_                         -> Int32
65
    WarningName
RewriteAmbiguousRules_                       -> Int32
66
    WarningName
RewriteMissingRule_                          -> Int32
67
    WarningName
SafeFlagEta_                                 -> Int32
68
    WarningName
SafeFlagInjective_                           -> Int32
69
    WarningName
SafeFlagNoCoverageCheck_                     -> Int32
70
    WarningName
SafeFlagNonTerminating_                      -> Int32
71
    WarningName
SafeFlagNoPositivityCheck_                   -> Int32
72
    WarningName
SafeFlagNoUniverseCheck_                     -> Int32
73
    WarningName
SafeFlagPolarity_                            -> Int32
74
    WarningName
SafeFlagPostulate_                           -> Int32
75
    WarningName
SafeFlagPragma_                              -> Int32
76
    WarningName
SafeFlagTerminating_                         -> Int32
77
    WarningName
SafeFlagWithoutKFlagPrimEraseEquality_       -> Int32
78
    WarningName
TerminationIssue_                            -> Int32
79
    WarningName
UnreachableClauses_                          -> Int32
80
    WarningName
UnsolvedConstraints_                         -> Int32
81
    WarningName
UnsolvedInteractionMetas_                    -> Int32
82
    WarningName
UnsolvedMetaVariables_                       -> Int32
83
    WarningName
UselessHiding_                               -> Int32
84
    WarningName
UselessInline_                               -> Int32
85
    WarningName
UselessPatternDeclarationForRecord_          -> Int32
86
    WarningName
UselessPublic_                               -> Int32
87
    WarningName
UserWarning_                                 -> Int32
88
    WarningName
WithoutKFlagPrimEraseEquality_               -> Int32
89
    WarningName
WrongInstanceDeclaration_                    -> Int32
90
    WarningName
CoInfectiveImport_                           -> Int32
91
    WarningName
InfectiveImport_                             -> Int32
92
    WarningName
DuplicateFieldsWarning_                      -> Int32
93
    WarningName
TooManyFieldsWarning_                        -> Int32
94
    WarningName
OptionRenamed_                               -> Int32
95

  value :: Int32 -> R WarningName
value = \case
    Int32
0  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
OverlappingTokensWarning_
    Int32
1  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnsupportedAttribute_
    Int32
2  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
MultipleAttributes_
    Int32
3  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
LibUnknownField_
    Int32
4  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyAbstract_
    Int32
5  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyConstructor_
    Int32
6  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyField_
    Int32
7  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyGeneralize_
    Int32
8  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyInstance_
    Int32
9  -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyMacro_
    Int32
10 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyMutual_
    Int32
11 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyPostulate_
    Int32
12 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyPrimitive_
    Int32
13 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyPrivate_
    Int32
14 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyRewritePragma_
    Int32
15 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
EmptyWhere_
    Int32
16 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
HiddenGeneralize_
    Int32
17 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidCatchallPragma_
    Int32
18 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidConstructor_
    Int32
19 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidConstructorBlock_
    Int32
20 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidCoverageCheckPragma_
    Int32
21 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidNoPositivityCheckPragma_
    Int32
22 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidNoUniverseCheckPragma_
    Int32
23 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidRecordDirective_
    Int32
24 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InvalidTerminationCheckPragma_
    Int32
25 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
MissingDeclarations_
    Int32
26 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
MissingDefinitions_
    Int32
27 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
NotAllowedInMutual_
    Int32
28 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
OpenPublicAbstract_
    Int32
29 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
OpenPublicPrivate_
    Int32
30 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
PolarityPragmasButNotPostulates_
    Int32
31 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
PragmaCompiled_
    Int32
32 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
PragmaNoTerminationCheck_
    Int32
33 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
ShadowingInTelescope_
    Int32
34 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnknownFixityInMixfixDecl_
    Int32
35 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnknownNamesInFixityDecl_
    Int32
36 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnknownNamesInPolarityPragmas_
    Int32
37 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessAbstract_
    Int32
38 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessInstance_
    Int32
39 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessPrivate_
    Int32
40 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
AbsurdPatternRequiresNoRHS_
    Int32
41 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
AsPatternShadowsConstructorOrPatternSynonym_
    Int32
42 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
CantGeneralizeOverSorts_
    Int32
43 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
ClashesViaRenaming_
    Int32
44 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
CoverageIssue_
    Int32
45 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
CoverageNoExactSplit_
    Int32
46 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
DeprecationWarning_
    Int32
47 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
DuplicateUsing_
    Int32
48 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
FixityInRenamingModule_
    Int32
49 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
GenericNonFatalError_
    Int32
50 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
GenericUseless_
    Int32
51 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
GenericWarning_
    Int32
52 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
IllformedAsClause_
    Int32
53 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InstanceArgWithExplicitArg_
    Int32
54 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InstanceWithExplicitArg_
    Int32
55 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InstanceNoOutputTypeName_
    Int32
56 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InversionDepthReached_
    Int32
57 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
ModuleDoesntExport_
    Int32
58 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
NoGuardednessFlag_
    Int32
59 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
NotInScope_
    Int32
60 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
NotStrictlyPositive_
    Int32
61 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnsupportedIndexedMatch_
    Int32
62 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
OldBuiltin_
    Int32
63 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
PragmaCompileErased_
    Int32
64 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
RewriteMaybeNonConfluent_
    Int32
65 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
RewriteNonConfluent_
    Int32
66 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
RewriteAmbiguousRules_
    Int32
67 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
RewriteMissingRule_
    Int32
68 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagEta_
    Int32
69 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagInjective_
    Int32
70 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagNoCoverageCheck_
    Int32
71 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagNonTerminating_
    Int32
72 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagNoPositivityCheck_
    Int32
73 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagNoUniverseCheck_
    Int32
74 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagPolarity_
    Int32
75 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagPostulate_
    Int32
76 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagPragma_
    Int32
77 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagTerminating_
    Int32
78 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
SafeFlagWithoutKFlagPrimEraseEquality_
    Int32
79 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
TerminationIssue_
    Int32
80 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnreachableClauses_
    Int32
81 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnsolvedConstraints_
    Int32
82 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnsolvedInteractionMetas_
    Int32
83 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UnsolvedMetaVariables_
    Int32
84 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessHiding_
    Int32
85 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessInline_
    Int32
86 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessPatternDeclarationForRecord_
    Int32
87 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UselessPublic_
    Int32
88 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
UserWarning_
    Int32
89 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
WithoutKFlagPrimEraseEquality_
    Int32
90 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
WrongInstanceDeclaration_
    Int32
91 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
CoInfectiveImport_
    Int32
92 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
InfectiveImport_
    Int32
93 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
DuplicateFieldsWarning_
    Int32
94 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
TooManyFieldsWarning_
    Int32
95 -> WarningName -> R WarningName
forall a. a -> ExceptT TypeError (StateT St IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return WarningName
OptionRenamed_
    Int32
_ -> R WarningName
forall a. R a
malformed


instance EmbPrj CutOff where
  icod_ :: CutOff -> S Int32
icod_ = \case
    CutOff
DontCutOff -> CutOff -> Arrows (Domains CutOff) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' CutOff
DontCutOff
    CutOff LineNumber
a -> Int32
-> (LineNumber -> CutOff)
-> Arrows (Domains (LineNumber -> CutOff)) (S Int32)
forall t.
(ICODE t (IsBase t), Currying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 LineNumber -> CutOff
CutOff LineNumber
a

  value :: Int32 -> R CutOff
value = (Node -> R CutOff) -> Int32 -> R CutOff
forall a. EmbPrj a => (Node -> R a) -> Int32 -> R a
vcase Node -> R CutOff
valu where
    valu :: Node
-> Arrows (Constant Int32 (Domains CutOff)) (R (CoDomain CutOff))
valu [] = CutOff
-> Arrows (Constant Int32 (Domains CutOff)) (R (CoDomain CutOff))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN CutOff
DontCutOff
    valu [Int32
0,Int32
a] = (LineNumber -> CutOff)
-> Arrows
     (Constant Int32 (Domains (LineNumber -> CutOff)))
     (R (CoDomain (LineNumber -> CutOff)))
forall t.
(VALU t (IsBase t),
 Currying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN LineNumber -> CutOff
CutOff Int32
a
    valu Node
_ = R CutOff
Arrows (Constant Int32 (Domains CutOff)) (R (CoDomain CutOff))
forall a. R a
malformed