{-# LANGUAGE DeriveLift #-}
module Morley.Micheline.Expression
( Exp(.., ExpPrim')
, expressionInt
, expressionString
, expressionBytes
, expressionSeq
, expressionPrim
, expressionPrim'
, RegularExp
, Expression
, MichelinePrimAp (..)
, MichelinePrimitive (..)
, MichelinePrimitiveTag (..)
, SingMichelinePrimitiveTag (..)
, ClassifiedMichelinePrimitive (..)
, withClassifiedPrim
, ExpExtensionDescriptorKind
, ExpExtensionDescriptor (..)
, ExpExtrasConstrained
, ExpAllExtrasConstrainted
, ExpExtras (..)
, mkUniformExpExtras
, hoistExpExtras
, Annotation (..)
, annotToText
, annotFromText
, isAnnotationField
, isAnnotationType
, isAnnotationVariable
, isNoAnn
, mkAnns
, toAnnSet
, mkAnnsFromAny
, _ExpInt
, _ExpString
, _ExpBytes
, _ExpSeq
, _ExpPrim
, _ExpressionInt
, _ExpressionString
, _ExpressionBytes
, _ExpressionSeq
, _ExpressionPrim
, _AnnotationField
, _AnnotationVariable
, _AnnotationType
, mpaPrimL
, mpaArgsL
, mpaAnnotsL
) where
import Control.Lens (Iso', Plated, Prism', iso)
import Control.Lens.TH (makeLensesWith, makePrisms)
import Data.Aeson
(FromJSON, ToJSON, object, parseJSON, toEncoding, toJSON, withObject, withText, (.!=), (.:),
(.:?), (.=))
import Data.Aeson.Encoding.Internal qualified as Aeson
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types qualified as Aeson
import Data.Data (Data)
import Data.Singletons (Sing, sing)
import Data.Text qualified as T
import Fmt (Buildable(..), listF, pretty, tupleF, unwordsF)
import Language.Haskell.TH (Dec(..), caseE, conE, conP, conT, gadtC, match, normalB)
import Language.Haskell.TH.Syntax (Lift)
import Morley.Micheline.Expression.Internal.MichelinePrimitive
import Morley.Micheline.Expression.Internal.TH
import Morley.Micheline.Json (StringEncode(StringEncode, unStringEncode))
import Morley.Michelson.Typed.ClassifiedInstr.Internal.TH (promote)
import Morley.Michelson.Untyped qualified as U
import Morley.Michelson.Untyped.Annotation
(AnnotationSet(..), FieldAnn, FieldTag, KnownAnnTag(..), TypeAnn, TypeTag, VarAnn, VarTag,
annPrefix, fullAnnSet, minimizeAnnSet, mkAnnotation)
import Morley.Tezos.Crypto (encodeBase58Check)
import Morley.Util.ByteString (HexJSONByteString(..))
import Morley.Util.Lens (postfixLFields)
do
[DataD cxt' name tvb mk _ ders] <-
[d|data ClassifiedMichelinePrimitive (tag :: MichelinePrimitiveTag) where|]
cons <- withMichelinePrimitiveCons \nm classifiedName ->
gadtC [classifiedName] [] [t|$(conT name) $(promote $ primClassification $ primFromName nm)|]
pure [DataD cxt' name tvb mk cons ders]
withClassifiedPrim
:: MichelinePrimitive
-> (forall tag. Sing tag -> ClassifiedMichelinePrimitive tag -> r)
-> r
withClassifiedPrim :: forall r.
MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
Sing tag -> ClassifiedMichelinePrimitive tag -> r)
-> r
withClassifiedPrim MichelinePrimitive
prim forall (tag :: MichelinePrimitiveTag).
Sing tag -> ClassifiedMichelinePrimitive tag -> r
f = $(do
matches <- withMichelinePrimitiveCons \nm classifiedName ->
match (conP nm []) (normalB [|f sing $(conE classifiedName)|]) []
caseE [|prim|] $ pure <$> matches
)
data Exp x
= ExpInt (XExpInt x) Integer
| ExpString (XExpString x) Text
| ExpBytes (XExpBytes x) ByteString
| ExpSeq (XExpSeq x) [Exp x]
| ExpPrim (XExpPrim x) (MichelinePrimAp x)
| ExpX (XExp x)
pattern ExpPrim' :: XExpPrim x -> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
pattern $mExpPrim' :: forall {r} {x :: ExpExtensionDescriptorKind}.
Exp x
-> (XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> r)
-> ((# #) -> r)
-> r
$bExpPrim' :: forall (x :: ExpExtensionDescriptorKind).
XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
ExpPrim' x primAp exprs anns = ExpPrim x (MichelinePrimAp primAp exprs anns)
deriving stock instance ExpAllExtrasConstrainted Eq x => Eq (Exp x)
deriving stock instance ExpAllExtrasConstrainted Show x => Show (Exp x)
deriving stock instance (ExpAllExtrasConstrainted Data x, Typeable x) => Data (Exp x)
deriving stock instance ExpAllExtrasConstrainted Lift x => Lift (Exp x)
type ExpExtensionDescriptorKind = ExpExtensionTag -> Type
data ExpExtensionTag
class ExpExtensionDescriptor (x :: ExpExtensionDescriptorKind) where
type XExpInt x :: Type
type XExpInt _ = ()
type XExpString x :: Type
type XExpString _ = ()
type XExpBytes x :: Type
type XExpBytes _ = ()
type XExpSeq x :: Type
type XExpSeq _ = ()
type XExpPrim x :: Type
type XExpPrim _ = ()
type XExp x :: Type
type XExp _ = Void
type c x =
Each '[c]
[XExpInt x, XExpString x, XExpBytes x, XExpSeq x, XExpPrim x]
type c x = (ExpExtrasConstrained c x, c (XExp x))
data f x =
{ forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpInt x)
eeInt :: f (XExpInt x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpString x)
eeString :: f (XExpString x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpBytes x)
eeBytes :: f (XExpBytes x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpSeq x)
eeSeq :: f (XExpSeq x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpPrim x)
eePrim :: f (XExpPrim x)
}
mkUniformExpExtras
:: ( extra ~ XExpInt x
, extra ~ XExpString x
, extra ~ XExpBytes x
, extra ~ XExpSeq x
, extra ~ XExpPrim x
)
=> f extra -> ExpExtras f x
f extra
x = f (XExpInt x)
-> f (XExpString x)
-> f (XExpBytes x)
-> f (XExpSeq x)
-> f (XExpPrim x)
-> ExpExtras f x
forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
f (XExpInt x)
-> f (XExpString x)
-> f (XExpBytes x)
-> f (XExpSeq x)
-> f (XExpPrim x)
-> ExpExtras f x
ExpExtras f extra
f (XExpInt x)
x f extra
f (XExpString x)
x f extra
f (XExpBytes x)
x f extra
f (XExpSeq x)
x f extra
f (XExpPrim x)
x
hoistExpExtras
:: (forall extra. f1 extra -> f2 extra)
-> ExpExtras f1 x -> ExpExtras f2 x
forall extra. f1 extra -> f2 extra
f ExpExtras{f1 (XExpInt x)
f1 (XExpString x)
f1 (XExpBytes x)
f1 (XExpSeq x)
f1 (XExpPrim x)
eeInt :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpInt x)
eeString :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpString x)
eeBytes :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpBytes x)
eeSeq :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpSeq x)
eePrim :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpPrim x)
eeInt :: f1 (XExpInt x)
eeString :: f1 (XExpString x)
eeBytes :: f1 (XExpBytes x)
eeSeq :: f1 (XExpSeq x)
eePrim :: f1 (XExpPrim x)
..} = ExpExtras
{ eeInt :: f2 (XExpInt x)
eeInt = f1 (XExpInt x) -> f2 (XExpInt x)
forall extra. f1 extra -> f2 extra
f f1 (XExpInt x)
eeInt
, eeString :: f2 (XExpString x)
eeString = f1 (XExpString x) -> f2 (XExpString x)
forall extra. f1 extra -> f2 extra
f f1 (XExpString x)
eeString
, eeBytes :: f2 (XExpBytes x)
eeBytes = f1 (XExpBytes x) -> f2 (XExpBytes x)
forall extra. f1 extra -> f2 extra
f f1 (XExpBytes x)
eeBytes
, eeSeq :: f2 (XExpSeq x)
eeSeq = f1 (XExpSeq x) -> f2 (XExpSeq x)
forall extra. f1 extra -> f2 extra
f f1 (XExpSeq x)
eeSeq
, eePrim :: f2 (XExpPrim x)
eePrim = f1 (XExpPrim x) -> f2 (XExpPrim x)
forall extra. f1 extra -> f2 extra
f f1 (XExpPrim x)
eePrim
}
data RegularExp :: ExpExtensionDescriptorKind
instance ExpExtensionDescriptor RegularExp
type Expression = Exp RegularExp
expressionInt :: Integer -> Expression
expressionInt :: Integer -> Expression
expressionInt Integer
a = XExpInt RegularExp -> Integer -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpInt x -> Integer -> Exp x
ExpInt () Integer
a
expressionString :: Text -> Expression
expressionString :: Text -> Expression
expressionString Text
a = XExpString RegularExp -> Text -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpString x -> Text -> Exp x
ExpString () Text
a
expressionBytes :: ByteString -> Expression
expressionBytes :: ByteString -> Expression
expressionBytes ByteString
a = XExpBytes RegularExp -> ByteString -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpBytes x -> ByteString -> Exp x
ExpBytes () ByteString
a
expressionSeq :: [Expression] -> Expression
expressionSeq :: [Expression] -> Expression
expressionSeq [Expression]
a = XExpSeq RegularExp -> [Expression] -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpSeq x -> [Exp x] -> Exp x
ExpSeq () [Expression]
a
expressionPrim :: MichelinePrimAp RegularExp -> Expression
expressionPrim :: MichelinePrimAp RegularExp -> Expression
expressionPrim MichelinePrimAp RegularExp
a = XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () MichelinePrimAp RegularExp
a
expressionPrim' :: MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' :: MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
prim [Expression]
args [Annotation]
anns =
XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp MichelinePrimitive
prim [Expression]
args [Annotation]
anns)
instance ( Typeable x
, ExpAllExtrasConstrainted Data x
, ExpAllExtrasConstrainted Typeable x)
=> Plated (Exp x)
instance Buildable Expression where
build :: Expression -> Doc
build = \case
ExpInt () Integer
i -> Integer -> Doc
forall a. Buildable a => a -> Doc
build Integer
i
ExpString () Text
s -> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
s
ExpBytes () ByteString
b ->
Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeBase58Check ByteString
b
ExpSeq () [Expression]
s -> [Expression] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
listF [Expression]
s
ExpPrim () (MichelinePrimAp MichelinePrimitive
prim [Expression]
s [Annotation]
annots) ->
[Doc] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
unwordsF [MichelinePrimitive -> Doc
forall a. Buildable a => a -> Doc
build MichelinePrimitive
prim, [Expression] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
listF [Expression]
s, [Text] -> Doc
forall a. TupleF a => a -> Doc
tupleF ([Text] -> Doc) -> [Text] -> Doc
forall a b. (a -> b) -> a -> b
$ Annotation -> Text
annotToText (Annotation -> Text) -> [Annotation] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotation]
annots]
data Annotation
= AnnotationType TypeAnn
| AnnotationVariable VarAnn
| AnnotationField FieldAnn
deriving stock (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
/= :: Annotation -> Annotation -> Bool
Eq, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Annotation -> ShowS
showsPrec :: Int -> Annotation -> ShowS
$cshow :: Annotation -> String
show :: Annotation -> String
$cshowList :: [Annotation] -> ShowS
showList :: [Annotation] -> ShowS
Show, Typeable Annotation
Typeable Annotation
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation)
-> (Annotation -> Constr)
-> (Annotation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Annotation))
-> ((forall b. Data b => b -> b) -> Annotation -> Annotation)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Annotation -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Annotation -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> Data Annotation
Annotation -> Constr
Annotation -> DataType
(forall b. Data b => b -> b) -> Annotation -> Annotation
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
$ctoConstr :: Annotation -> Constr
toConstr :: Annotation -> Constr
$cdataTypeOf :: Annotation -> DataType
dataTypeOf :: Annotation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
$cgmapT :: (forall b. Data b => b -> b) -> Annotation -> Annotation
gmapT :: (forall b. Data b => b -> b) -> Annotation -> Annotation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
Data, (forall (m :: * -> *). Quote m => Annotation -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
Annotation -> Code m Annotation)
-> Lift Annotation
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Annotation -> m Exp
forall (m :: * -> *). Quote m => Annotation -> Code m Annotation
$clift :: forall (m :: * -> *). Quote m => Annotation -> m Exp
lift :: forall (m :: * -> *). Quote m => Annotation -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Annotation -> Code m Annotation
liftTyped :: forall (m :: * -> *). Quote m => Annotation -> Code m Annotation
Lift)
data MichelinePrimAp x = MichelinePrimAp
{ forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> MichelinePrimitive
mpaPrim :: MichelinePrimitive
, forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Exp x]
mpaArgs :: [Exp x]
, forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Annotation]
mpaAnnots :: [Annotation]
}
deriving stock instance Eq (Exp x) => Eq (MichelinePrimAp x)
deriving stock instance Show (Exp x) => Show (MichelinePrimAp x)
deriving stock instance (Data (Exp x), Typeable x) => Data (MichelinePrimAp x)
deriving stock instance Lift (Exp x) => Lift (MichelinePrimAp x)
instance FromJSON (Exp x) => FromJSON (MichelinePrimAp x) where
parseJSON :: Value -> Parser (MichelinePrimAp x)
parseJSON = String
-> (Object -> Parser (MichelinePrimAp x))
-> Value
-> Parser (MichelinePrimAp x)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Prim" ((Object -> Parser (MichelinePrimAp x))
-> Value -> Parser (MichelinePrimAp x))
-> (Object -> Parser (MichelinePrimAp x))
-> Value
-> Parser (MichelinePrimAp x)
forall a b. (a -> b) -> a -> b
$ \Object
v -> MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp
(MichelinePrimitive
-> [Exp x] -> [Annotation] -> MichelinePrimAp x)
-> Parser MichelinePrimitive
-> Parser ([Exp x] -> [Annotation] -> MichelinePrimAp x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MichelinePrimitive
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prim"
Parser ([Exp x] -> [Annotation] -> MichelinePrimAp x)
-> Parser [Exp x] -> Parser ([Annotation] -> MichelinePrimAp x)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Exp x])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"args" Parser (Maybe [Exp x]) -> [Exp x] -> Parser [Exp x]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
Parser ([Annotation] -> MichelinePrimAp x)
-> Parser [Annotation] -> Parser (MichelinePrimAp x)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Annotation])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annots" Parser (Maybe [Annotation]) -> [Annotation] -> Parser [Annotation]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
instance ToJSON (Exp x) => ToJSON (MichelinePrimAp x) where
toJSON :: MichelinePrimAp x -> Value
toJSON MichelinePrimAp {[Annotation]
[Exp x]
MichelinePrimitive
mpaPrim :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> MichelinePrimitive
mpaArgs :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Exp x]
mpaAnnots :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Annotation]
mpaPrim :: MichelinePrimitive
mpaArgs :: [Exp x]
mpaAnnots :: [Annotation]
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
[ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"prim" Key -> MichelinePrimitive -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MichelinePrimitive
mpaPrim)
, if [Exp x] -> Bool
forall t. Container t => t -> Bool
null [Exp x]
mpaArgs then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"args" Key -> [Exp x] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Exp x]
mpaArgs)
, if [Annotation] -> Bool
forall t. Container t => t -> Bool
null [Annotation]
mpaAnnots then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"annots" Key -> [Annotation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Annotation]
mpaAnnots)
]
annotFromText :: forall m. MonadFail m => Text -> m Annotation
annotFromText :: forall (m :: * -> *). MonadFail m => Text -> m Annotation
annotFromText Text
txt = do
(Char
n, Text
t) <-
m (Char, Text)
-> ((Char, Text) -> m (Char, Text))
-> Maybe (Char, Text)
-> m (Char, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (Char, Text)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Char, Text)) -> String -> m (Char, Text)
forall a b. (a -> b) -> a -> b
$ String
"Annotation '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
txt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' is missing an annotation prefix.") (Char, Text) -> m (Char, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Char, Text) -> m (Char, Text))
-> Maybe (Char, Text) -> m (Char, Text)
forall a b. (a -> b) -> a -> b
$
Text -> Maybe (Char, Text)
T.uncons Text
txt
if | String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall tag. KnownAnnTag tag => Text
annPrefix @TypeTag -> Either Text Annotation -> m Annotation
forall a. Either Text a -> m a
handleErr (Either Text Annotation -> m Annotation)
-> Either Text Annotation -> m Annotation
forall a b. (a -> b) -> a -> b
$ TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation)
-> Either Text TypeAnn -> Either Text Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text TypeAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
t
| String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall tag. KnownAnnTag tag => Text
annPrefix @VarTag -> Either Text Annotation -> m Annotation
forall a. Either Text a -> m a
handleErr (Either Text Annotation -> m Annotation)
-> Either Text Annotation -> m Annotation
forall a b. (a -> b) -> a -> b
$ VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation)
-> Either Text VarAnn -> Either Text Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text VarAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
t
| String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall tag. KnownAnnTag tag => Text
annPrefix @FieldTag -> Either Text Annotation -> m Annotation
forall a. Either Text a -> m a
handleErr (Either Text Annotation -> m Annotation)
-> Either Text Annotation -> m Annotation
forall a b. (a -> b) -> a -> b
$ FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation)
-> Either Text FieldAnn -> Either Text Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text FieldAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
t
| Bool
otherwise -> String -> m Annotation
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Annotation) -> String -> m Annotation
forall a b. (a -> b) -> a -> b
$ String
"Unknown annotation type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
txt
where
handleErr :: Either Text a -> m a
handleErr :: forall a. Either Text a -> m a
handleErr = \case
Left Text
err -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse annotation '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
txt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
err
Right a
a -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
annotToText :: Annotation -> Text
annotToText :: Annotation -> Text
annotToText = \case
AnnotationType TypeAnn
n -> TypeAnn -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty TypeAnn
n
AnnotationVariable VarAnn
n -> VarAnn -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty VarAnn
n
AnnotationField FieldAnn
n -> FieldAnn -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty FieldAnn
n
mkAnns :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas =
let minAnnSet :: AnnotationSet
minAnnSet = AnnotationSet -> AnnotationSet
minimizeAnnSet (AnnotationSet -> AnnotationSet) -> AnnotationSet -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas
in (TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation) -> [TypeAnn] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotationSet -> [TypeAnn]
asTypes AnnotationSet
minAnnSet) [Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<>
(FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation) -> [FieldAnn] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotationSet -> [FieldAnn]
asFields AnnotationSet
minAnnSet) [Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<>
(VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation) -> [VarAnn] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotationSet -> [VarAnn]
asVars AnnotationSet
minAnnSet)
mkAnnsFromAny :: [U.AnyAnn] -> [Annotation]
mkAnnsFromAny :: [AnyAnn] -> [Annotation]
mkAnnsFromAny [AnyAnn]
xs = [AnyAnn]
xs [AnyAnn] -> (AnyAnn -> Annotation) -> [Annotation]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
U.AnyAnnType TypeAnn
x -> TypeAnn -> Annotation
AnnotationType TypeAnn
x
U.AnyAnnField FieldAnn
x -> FieldAnn -> Annotation
AnnotationField FieldAnn
x
U.AnyAnnVar VarAnn
x -> VarAnn -> Annotation
AnnotationVariable VarAnn
x
isAnnotationField :: Annotation -> Bool
isAnnotationField :: Annotation -> Bool
isAnnotationField = \case
AnnotationField FieldAnn
_ -> Bool
True
Annotation
_ -> Bool
False
isAnnotationVariable :: Annotation -> Bool
isAnnotationVariable :: Annotation -> Bool
isAnnotationVariable = \case
AnnotationVariable VarAnn
_ -> Bool
True
Annotation
_ -> Bool
False
isAnnotationType :: Annotation -> Bool
isAnnotationType :: Annotation -> Bool
isAnnotationType = \case
AnnotationType TypeAnn
_ -> Bool
True
Annotation
_ -> Bool
False
isNoAnn :: Annotation -> Bool
isNoAnn :: Annotation -> Bool
isNoAnn = \case
AnnotationVariable (U.Annotation Text
"") -> Bool
True
AnnotationField (U.Annotation Text
"") -> Bool
True
AnnotationType (U.Annotation Text
"") -> Bool
True
Annotation
_ -> Bool
False
toAnnSet :: [Annotation] -> AnnotationSet
toAnnSet :: [Annotation] -> AnnotationSet
toAnnSet = (Element [Annotation] -> AnnotationSet)
-> [Annotation] -> AnnotationSet
forall m.
Monoid m =>
(Element [Annotation] -> m) -> [Annotation] -> m
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap ((Element [Annotation] -> AnnotationSet)
-> [Annotation] -> AnnotationSet)
-> (Element [Annotation] -> AnnotationSet)
-> [Annotation]
-> AnnotationSet
forall a b. (a -> b) -> a -> b
$ \case
AnnotationType TypeAnn
a -> TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet TypeAnn
a
AnnotationField FieldAnn
a -> FieldAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet FieldAnn
a
AnnotationVariable VarAnn
a -> VarAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet VarAnn
a
instance FromJSON Annotation where
parseJSON :: Value -> Parser Annotation
parseJSON = String -> (Text -> Parser Annotation) -> Value -> Parser Annotation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Annotation" Text -> Parser Annotation
forall (m :: * -> *). MonadFail m => Text -> m Annotation
annotFromText
instance ToJSON Annotation where
toJSON :: Annotation -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Annotation -> Text) -> Annotation -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText
toEncoding :: Annotation -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (Annotation -> Text) -> Annotation -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText
instance FromJSON Expression where
parseJSON :: Value -> Parser Expression
parseJSON Value
v = XExpSeq RegularExp -> [Expression] -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpSeq x -> [Exp x] -> Exp x
ExpSeq () ([Expression] -> Expression)
-> Parser [Expression] -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Expression]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Expression)
-> Parser (MichelinePrimAp RegularExp) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (MichelinePrimAp RegularExp)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XExpString RegularExp -> Text -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpString x -> Text -> Exp x
ExpString () (Text -> Expression) -> Parser Text -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExpressionString" (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"string") Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XExpInt RegularExp -> Integer -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpInt x -> Integer -> Exp x
ExpInt () (Integer -> Expression)
-> (StringEncode Integer -> Integer)
-> StringEncode Integer
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringEncode Integer -> Integer
forall a. StringEncode a -> a
unStringEncode (StringEncode Integer -> Expression)
-> Parser (StringEncode Integer) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser (StringEncode Integer))
-> Value
-> Parser (StringEncode Integer)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExpressionInt" (Object -> Key -> Parser (StringEncode Integer)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"int") Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XExpBytes RegularExp -> ByteString -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpBytes x -> ByteString -> Exp x
ExpBytes () (ByteString -> Expression)
-> (HexJSONByteString -> ByteString)
-> HexJSONByteString
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexJSONByteString -> ByteString
unHexJSONByteString (HexJSONByteString -> Expression)
-> Parser HexJSONByteString -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser HexJSONByteString)
-> Value
-> Parser HexJSONByteString
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExpressionBytes" (Object -> Key -> Parser HexJSONByteString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bytes") Value
v
instance ToJSON Expression where
toJSON :: Expression -> Value
toJSON (ExpSeq () [Expression]
xs) = [Expression] -> Value
forall a. ToJSON a => a -> Value
toJSON [Expression]
xs
toJSON (ExpPrim () MichelinePrimAp RegularExp
xs) = MichelinePrimAp RegularExp -> Value
forall a. ToJSON a => a -> Value
toJSON MichelinePrimAp RegularExp
xs
toJSON (ExpString () Text
x) = Object -> Value
Aeson.Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"string" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x)
toJSON (ExpInt () Integer
x) = Object -> Value
Aeson.Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"int" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ StringEncode Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (StringEncode Integer -> Value) -> StringEncode Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncode Integer
forall a. a -> StringEncode a
StringEncode Integer
x)
toJSON (ExpBytes () ByteString
x) = Object -> Value
Aeson.Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"bytes" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ HexJSONByteString -> Value
forall a. ToJSON a => a -> Value
toJSON (HexJSONByteString -> Value) -> HexJSONByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> HexJSONByteString
HexJSONByteString ByteString
x)
toEncoding :: Expression -> Encoding
toEncoding (ExpSeq () [Expression]
xs) = [Expression] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Expression]
xs
toEncoding (ExpPrim () MichelinePrimAp RegularExp
xs) = MichelinePrimAp RegularExp -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding MichelinePrimAp RegularExp
xs
toEncoding (ExpString () Text
x) = Series -> Encoding
Aeson.pairs (Key -> Encoding -> Series
Aeson.pair Key
"string" (Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
x))
toEncoding (ExpInt () Integer
x) = Series -> Encoding
Aeson.pairs (Key -> Encoding -> Series
Aeson.pair Key
"int" (StringEncode Integer -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (StringEncode Integer -> Encoding)
-> StringEncode Integer -> Encoding
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncode Integer
forall a. a -> StringEncode a
StringEncode Integer
x))
toEncoding (ExpBytes () ByteString
x) = Series -> Encoding
Aeson.pairs (Key -> Encoding -> Series
Aeson.pair Key
"bytes" (HexJSONByteString -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (HexJSONByteString -> Encoding) -> HexJSONByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> HexJSONByteString
HexJSONByteString ByteString
x))
makePrisms ''Exp
neglecting :: Iso' ((), a) a
neglecting :: forall a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f a) -> p ((), a) (f ((), a))
neglecting = (((), a) -> a) -> (a -> ((), a)) -> Iso ((), a) ((), a) a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((), a) -> a
forall a b. (a, b) -> b
snd a -> ((), a)
forall a. a -> ((), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
_ExpressionInt :: Prism' Expression Integer
_ExpressionInt :: Prism' Expression Integer
_ExpressionInt = p ((), Integer) (f ((), Integer)) -> p Expression (f Expression)
p (XExpInt RegularExp, Integer) (f (XExpInt RegularExp, Integer))
-> p Expression (f Expression)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
(f :: * -> *).
(Choice p, Applicative f) =>
p (XExpInt x, Integer) (f (XExpInt x, Integer))
-> p (Exp x) (f (Exp x))
_ExpInt (p ((), Integer) (f ((), Integer)) -> p Expression (f Expression))
-> (p Integer (f Integer) -> p ((), Integer) (f ((), Integer)))
-> p Integer (f Integer)
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Integer (f Integer) -> p ((), Integer) (f ((), Integer))
forall a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f a) -> p ((), a) (f ((), a))
neglecting
_ExpressionString :: Prism' Expression Text
_ExpressionString :: Prism' Expression Text
_ExpressionString = p ((), Text) (f ((), Text)) -> p Expression (f Expression)
p (XExpString RegularExp, Text) (f (XExpString RegularExp, Text))
-> p Expression (f Expression)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
(f :: * -> *).
(Choice p, Applicative f) =>
p (XExpString x, Text) (f (XExpString x, Text))
-> p (Exp x) (f (Exp x))
_ExpString (p ((), Text) (f ((), Text)) -> p Expression (f Expression))
-> (p Text (f Text) -> p ((), Text) (f ((), Text)))
-> p Text (f Text)
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p ((), Text) (f ((), Text))
forall a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f a) -> p ((), a) (f ((), a))
neglecting
_ExpressionBytes :: Prism' Expression ByteString
_ExpressionBytes :: Prism' Expression ByteString
_ExpressionBytes = p ((), ByteString) (f ((), ByteString))
-> p Expression (f Expression)
p (XExpBytes RegularExp, ByteString)
(f (XExpBytes RegularExp, ByteString))
-> p Expression (f Expression)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
(f :: * -> *).
(Choice p, Applicative f) =>
p (XExpBytes x, ByteString) (f (XExpBytes x, ByteString))
-> p (Exp x) (f (Exp x))
_ExpBytes (p ((), ByteString) (f ((), ByteString))
-> p Expression (f Expression))
-> (p ByteString (f ByteString)
-> p ((), ByteString) (f ((), ByteString)))
-> p ByteString (f ByteString)
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ByteString (f ByteString)
-> p ((), ByteString) (f ((), ByteString))
forall a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f a) -> p ((), a) (f ((), a))
neglecting
_ExpressionSeq :: Prism' Expression [Expression]
_ExpressionSeq :: Prism' Expression [Expression]
_ExpressionSeq = p ((), [Expression]) (f ((), [Expression]))
-> p Expression (f Expression)
p (XExpSeq RegularExp, [Expression])
(f (XExpSeq RegularExp, [Expression]))
-> p Expression (f Expression)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
(f :: * -> *).
(Choice p, Applicative f) =>
p (XExpSeq x, [Exp x]) (f (XExpSeq x, [Exp x]))
-> p (Exp x) (f (Exp x))
_ExpSeq (p ((), [Expression]) (f ((), [Expression]))
-> p Expression (f Expression))
-> (p [Expression] (f [Expression])
-> p ((), [Expression]) (f ((), [Expression])))
-> p [Expression] (f [Expression])
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p [Expression] (f [Expression])
-> p ((), [Expression]) (f ((), [Expression]))
forall a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f a) -> p ((), a) (f ((), a))
neglecting
_ExpressionPrim :: Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim :: Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim = p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp))
-> p Expression (f Expression)
p (XExpPrim RegularExp, MichelinePrimAp RegularExp)
(f (XExpPrim RegularExp, MichelinePrimAp RegularExp))
-> p Expression (f Expression)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
(f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
(f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp))
-> p Expression (f Expression))
-> (p (MichelinePrimAp RegularExp) (f (MichelinePrimAp RegularExp))
-> p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp)))
-> p (MichelinePrimAp RegularExp) (f (MichelinePrimAp RegularExp))
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (MichelinePrimAp RegularExp) (f (MichelinePrimAp RegularExp))
-> p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp))
forall a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f a) -> p ((), a) (f ((), a))
neglecting
makePrisms ''Annotation
makeLensesWith postfixLFields ''MichelinePrimAp