module Morley.Michelson.Untyped.Annotation
( Annotation (..)
, VarAnns (..)
, pattern Annotation
, pattern WithAnn
, AnnotationSet(..)
, annsCount
, emptyAnnSet
, firstAnn
, fullAnnSet
, isNoAnnSet
, minAnnSetSize
, secondAnn
, singleAnnSet
, singleGroupAnnSet
, minimizeAnnSet
, KnownAnnTag(..)
, TypeAnn
, FieldAnn
, VarAnn
, SomeAnn
, RootAnn
, TypeTag
, FieldTag
, VarTag
, noAnn
, annQ
, varAnnQ
, fieldAnnQ
, typeAnnQ
, unsafeMkAnnotation
, mkAnnotation
, specialVarAnns
, specialFieldAnn
, isValidAnnStart
, isValidAnnBodyChar
, orAnn
, unifyAnn
, unifyPairFieldAnn
, convergeVarAnns
, ifAnnUnified
, convAnn
) where
import Data.Aeson.TH (deriveJSON)
import Data.Char (isAlpha, isAscii, isDigit, isNumber)
import Data.Data (Data(..))
import Data.Default (Default(..))
import qualified Data.Text as T
import Data.Typeable (eqT, (:~:)(..))
import Fmt (Buildable(build))
import Instances.TH.Lift ()
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Lift (deriveLift)
import qualified Language.Haskell.TH.Quote as TH
import Text.PrettyPrint.Leijen.Text (Doc, hsep, textStrict, (<+>))
import qualified Text.Show
import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDoc, doesntNeedParens, printDocS)
import Morley.Util.Aeson
newtype Annotation tag = UnsafeAnnotation { Annotation tag -> Text
unAnnotation :: Text }
deriving stock (Annotation tag -> Annotation tag -> Bool
(Annotation tag -> Annotation tag -> Bool)
-> (Annotation tag -> Annotation tag -> Bool)
-> Eq (Annotation tag)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (tag :: k). Annotation tag -> Annotation tag -> Bool
/= :: Annotation tag -> Annotation tag -> Bool
$c/= :: forall k (tag :: k). Annotation tag -> Annotation tag -> Bool
== :: Annotation tag -> Annotation tag -> Bool
$c== :: forall k (tag :: k). Annotation tag -> Annotation tag -> Bool
Eq, Typeable (Annotation tag)
DataType
Constr
Typeable (Annotation tag)
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation tag -> c (Annotation tag))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Annotation tag))
-> (Annotation tag -> Constr)
-> (Annotation tag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Annotation tag)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation tag)))
-> ((forall b. Data b => b -> b)
-> Annotation tag -> Annotation tag)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r)
-> (forall u.
(forall d. Data d => d -> u) -> Annotation tag -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Annotation tag -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag))
-> Data (Annotation tag)
Annotation tag -> DataType
Annotation tag -> Constr
(forall b. Data b => b -> b) -> Annotation tag -> Annotation tag
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation tag -> c (Annotation tag)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Annotation tag)
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 tag -> u
forall u. (forall d. Data d => d -> u) -> Annotation tag -> [u]
forall k (tag :: k).
(Typeable tag, Typeable k) =>
Typeable (Annotation tag)
forall k (tag :: k).
(Typeable tag, Typeable k) =>
Annotation tag -> DataType
forall k (tag :: k).
(Typeable tag, Typeable k) =>
Annotation tag -> Constr
forall k (tag :: k).
(Typeable tag, Typeable k) =>
(forall b. Data b => b -> b) -> Annotation tag -> Annotation tag
forall k (tag :: k) u.
(Typeable tag, Typeable k) =>
Int -> (forall d. Data d => d -> u) -> Annotation tag -> u
forall k (tag :: k) u.
(Typeable tag, Typeable k) =>
(forall d. Data d => d -> u) -> Annotation tag -> [u]
forall k (tag :: k) r r'.
(Typeable tag, Typeable k) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
forall k (tag :: k) r r'.
(Typeable tag, Typeable k) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
forall k (tag :: k) (m :: * -> *).
(Typeable tag, Typeable k, Monad m) =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
forall k (tag :: k) (m :: * -> *).
(Typeable tag, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
forall k (tag :: k) (c :: * -> *).
(Typeable tag, Typeable k) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Annotation tag)
forall k (tag :: k) (c :: * -> *).
(Typeable tag, Typeable k) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation tag -> c (Annotation tag)
forall k (tag :: k) (t :: * -> *) (c :: * -> *).
(Typeable tag, Typeable k, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Annotation tag))
forall k (tag :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable tag, Typeable k, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation tag))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Annotation tag)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation tag -> c (Annotation tag)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Annotation tag))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation tag))
$cUnsafeAnnotation :: Constr
$tAnnotation :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
$cgmapMo :: forall k (tag :: k) (m :: * -> *).
(Typeable tag, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
gmapMp :: (forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
$cgmapMp :: forall k (tag :: k) (m :: * -> *).
(Typeable tag, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
gmapM :: (forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
$cgmapM :: forall k (tag :: k) (m :: * -> *).
(Typeable tag, Typeable k, Monad m) =>
(forall d. Data d => d -> m d)
-> Annotation tag -> m (Annotation tag)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Annotation tag -> u
$cgmapQi :: forall k (tag :: k) u.
(Typeable tag, Typeable k) =>
Int -> (forall d. Data d => d -> u) -> Annotation tag -> u
gmapQ :: (forall d. Data d => d -> u) -> Annotation tag -> [u]
$cgmapQ :: forall k (tag :: k) u.
(Typeable tag, Typeable k) =>
(forall d. Data d => d -> u) -> Annotation tag -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
$cgmapQr :: forall k (tag :: k) r r'.
(Typeable tag, Typeable k) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
$cgmapQl :: forall k (tag :: k) r r'.
(Typeable tag, Typeable k) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation tag -> r
gmapT :: (forall b. Data b => b -> b) -> Annotation tag -> Annotation tag
$cgmapT :: forall k (tag :: k).
(Typeable tag, Typeable k) =>
(forall b. Data b => b -> b) -> Annotation tag -> Annotation tag
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation tag))
$cdataCast2 :: forall k (tag :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable tag, Typeable k, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation tag))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Annotation tag))
$cdataCast1 :: forall k (tag :: k) (t :: * -> *) (c :: * -> *).
(Typeable tag, Typeable k, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Annotation tag))
dataTypeOf :: Annotation tag -> DataType
$cdataTypeOf :: forall k (tag :: k).
(Typeable tag, Typeable k) =>
Annotation tag -> DataType
toConstr :: Annotation tag -> Constr
$ctoConstr :: forall k (tag :: k).
(Typeable tag, Typeable k) =>
Annotation tag -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Annotation tag)
$cgunfold :: forall k (tag :: k) (c :: * -> *).
(Typeable tag, Typeable k) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Annotation tag)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation tag -> c (Annotation tag)
$cgfoldl :: forall k (tag :: k) (c :: * -> *).
(Typeable tag, Typeable k) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation tag -> c (Annotation tag)
$cp1Data :: forall k (tag :: k).
(Typeable tag, Typeable k) =>
Typeable (Annotation tag)
Data, (a -> b) -> Annotation a -> Annotation b
(forall a b. (a -> b) -> Annotation a -> Annotation b)
-> (forall a b. a -> Annotation b -> Annotation a)
-> Functor Annotation
forall a b. a -> Annotation b -> Annotation a
forall a b. (a -> b) -> Annotation a -> Annotation b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Annotation b -> Annotation a
$c<$ :: forall a b. a -> Annotation b -> Annotation a
fmap :: (a -> b) -> Annotation a -> Annotation b
$cfmap :: forall a b. (a -> b) -> Annotation a -> Annotation b
Functor, (forall x. Annotation tag -> Rep (Annotation tag) x)
-> (forall x. Rep (Annotation tag) x -> Annotation tag)
-> Generic (Annotation tag)
forall x. Rep (Annotation tag) x -> Annotation tag
forall x. Annotation tag -> Rep (Annotation tag) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (tag :: k) x. Rep (Annotation tag) x -> Annotation tag
forall k (tag :: k) x. Annotation tag -> Rep (Annotation tag) x
$cto :: forall k (tag :: k) x. Rep (Annotation tag) x -> Annotation tag
$cfrom :: forall k (tag :: k) x. Annotation tag -> Rep (Annotation tag) x
Generic)
instance NFData (Annotation tag)
pattern Annotation :: Text -> Annotation tag
pattern $mAnnotation :: forall r k (tag :: k).
Annotation tag -> (Text -> r) -> (Void# -> r) -> r
Annotation ann <- UnsafeAnnotation ann
{-# COMPLETE Annotation :: Annotation #-}
instance Default (Annotation tag) where
def :: Annotation tag
def = Annotation tag
forall k (tag :: k). Annotation tag
noAnn
data VarAnns
= OneVarAnn VarAnn
| TwoVarAnns VarAnn VarAnn
deriving stock ((forall x. VarAnns -> Rep VarAnns x)
-> (forall x. Rep VarAnns x -> VarAnns) -> Generic VarAnns
forall x. Rep VarAnns x -> VarAnns
forall x. VarAnns -> Rep VarAnns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarAnns x -> VarAnns
$cfrom :: forall x. VarAnns -> Rep VarAnns x
Generic, Int -> VarAnns -> ShowS
[VarAnns] -> ShowS
VarAnns -> String
(Int -> VarAnns -> ShowS)
-> (VarAnns -> String) -> ([VarAnns] -> ShowS) -> Show VarAnns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarAnns] -> ShowS
$cshowList :: [VarAnns] -> ShowS
show :: VarAnns -> String
$cshow :: VarAnns -> String
showsPrec :: Int -> VarAnns -> ShowS
$cshowsPrec :: Int -> VarAnns -> ShowS
Show)
deriving anyclass (VarAnns -> ()
(VarAnns -> ()) -> NFData VarAnns
forall a. (a -> ()) -> NFData a
rnf :: VarAnns -> ()
$crnf :: VarAnns -> ()
NFData)
data AnnotationSet = AnnotationSet
{ AnnotationSet -> [TypeAnn]
asTypes :: [TypeAnn]
, AnnotationSet -> [FieldAnn]
asFields :: [FieldAnn]
, AnnotationSet -> [VarAnn]
asVars :: [VarAnn]
} deriving stock AnnotationSet -> AnnotationSet -> Bool
(AnnotationSet -> AnnotationSet -> Bool)
-> (AnnotationSet -> AnnotationSet -> Bool) -> Eq AnnotationSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotationSet -> AnnotationSet -> Bool
$c/= :: AnnotationSet -> AnnotationSet -> Bool
== :: AnnotationSet -> AnnotationSet -> Bool
$c== :: AnnotationSet -> AnnotationSet -> Bool
Eq
instance Semigroup AnnotationSet where
(AnnotationSet [TypeAnn]
ts1 [FieldAnn]
fs1 [VarAnn]
vs1) <> :: AnnotationSet -> AnnotationSet -> AnnotationSet
<> (AnnotationSet [TypeAnn]
ts2 [FieldAnn]
fs2 [VarAnn]
vs2) = AnnotationSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
..}
where
asTypes :: [TypeAnn]
asTypes = [TypeAnn]
ts1 [TypeAnn] -> [TypeAnn] -> [TypeAnn]
forall a. Semigroup a => a -> a -> a
<> [TypeAnn]
ts2
asFields :: [FieldAnn]
asFields = [FieldAnn]
fs1 [FieldAnn] -> [FieldAnn] -> [FieldAnn]
forall a. Semigroup a => a -> a -> a
<> [FieldAnn]
fs2
asVars :: [VarAnn]
asVars = [VarAnn]
vs1 [VarAnn] -> [VarAnn] -> [VarAnn]
forall a. Semigroup a => a -> a -> a
<> [VarAnn]
vs2
instance Monoid AnnotationSet where
mempty :: AnnotationSet
mempty = AnnotationSet
emptyAnnSet
emptyAnnSet :: AnnotationSet
emptyAnnSet :: AnnotationSet
emptyAnnSet = [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
AnnotationSet [] [] []
singleAnnSet :: forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet :: Annotation tag -> AnnotationSet
singleAnnSet Annotation tag
an = [Annotation tag] -> AnnotationSet
forall tag. KnownAnnTag tag => [Annotation tag] -> AnnotationSet
singleGroupAnnSet [Annotation tag
an]
singleGroupAnnSet :: forall tag. KnownAnnTag tag => [Annotation tag] -> AnnotationSet
singleGroupAnnSet :: [Annotation tag] -> AnnotationSet
singleGroupAnnSet [Annotation tag]
ans = AnnotationSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
..}
where
asTypes :: [TypeAnn]
asTypes = case (Typeable tag, Typeable TypeTag) => Maybe (tag :~: TypeTag)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @tag @TypeTag of Just tag :~: TypeTag
Refl -> [Annotation tag]
[TypeAnn]
ans; Maybe (tag :~: TypeTag)
Nothing -> []
asFields :: [FieldAnn]
asFields = case (Typeable tag, Typeable FieldTag) => Maybe (tag :~: FieldTag)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @tag @FieldTag of Just tag :~: FieldTag
Refl -> [Annotation tag]
[FieldAnn]
ans; Maybe (tag :~: FieldTag)
Nothing -> []
asVars :: [VarAnn]
asVars = case (Typeable tag, Typeable VarTag) => Maybe (tag :~: VarTag)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @tag @VarTag of Just tag :~: VarTag
Refl -> [Annotation tag]
[VarAnn]
ans; Maybe (tag :~: VarTag)
Nothing -> []
fullAnnSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn]
asTypes [FieldAnn]
asFields [VarAnn]
asVars = AnnotationSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
..}
isNoAnnSet :: AnnotationSet -> Bool
isNoAnnSet :: AnnotationSet -> Bool
isNoAnnSet AnnotationSet
annSet = [TypeAnn] -> Bool
forall t. Container t => t -> Bool
null [TypeAnn]
asTypes Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& [FieldAnn] -> Bool
forall t. Container t => t -> Bool
null [FieldAnn]
asFields Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& [VarAnn] -> Bool
forall t. Container t => t -> Bool
null [VarAnn]
asVars
where AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: AnnotationSet -> [VarAnn]
asFields :: AnnotationSet -> [FieldAnn]
asTypes :: AnnotationSet -> [TypeAnn]
..} = AnnotationSet -> AnnotationSet
minimizeAnnSet AnnotationSet
annSet
minAnnSetSize :: AnnotationSet -> Int
minAnnSetSize :: AnnotationSet -> Int
minAnnSetSize AnnotationSet
annSet = [TypeAnn] -> Int
forall t. Container t => t -> Int
length [TypeAnn]
asTypes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [FieldAnn] -> Int
forall t. Container t => t -> Int
length [FieldAnn]
asFields Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [VarAnn] -> Int
forall t. Container t => t -> Int
length [VarAnn]
asVars
where AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: AnnotationSet -> [VarAnn]
asFields :: AnnotationSet -> [FieldAnn]
asTypes :: AnnotationSet -> [TypeAnn]
..} = AnnotationSet -> AnnotationSet
minimizeAnnSet AnnotationSet
annSet
minimizeAnnSet :: AnnotationSet -> AnnotationSet
minimizeAnnSet :: AnnotationSet -> AnnotationSet
minimizeAnnSet (AnnotationSet [TypeAnn]
ts [FieldAnn]
fs [VarAnn]
vs) = AnnotationSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
..}
where
asTypes :: [TypeAnn]
asTypes = [TypeAnn] -> [TypeAnn]
forall k (tag :: k). [Annotation tag] -> [Annotation tag]
trimEndNoAnn [TypeAnn]
ts
asFields :: [FieldAnn]
asFields = [FieldAnn] -> [FieldAnn]
forall k (tag :: k). [Annotation tag] -> [Annotation tag]
trimEndNoAnn [FieldAnn]
fs
asVars :: [VarAnn]
asVars = [VarAnn] -> [VarAnn]
forall k (tag :: k). [Annotation tag] -> [Annotation tag]
trimEndNoAnn [VarAnn]
vs
trimEndNoAnn :: [Annotation tag] -> [Annotation tag]
trimEndNoAnn :: [Annotation tag] -> [Annotation tag]
trimEndNoAnn = (Element [Annotation tag] -> [Annotation tag] -> [Annotation tag])
-> [Annotation tag] -> [Annotation tag] -> [Annotation tag]
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (\Element [Annotation tag]
a [Annotation tag]
lst -> if [Annotation tag] -> Bool
forall t. Container t => t -> Bool
null [Annotation tag]
lst Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Element [Annotation tag]
Annotation tag
a Annotation tag -> Annotation tag -> Bool
forall a. Eq a => a -> a -> Bool
== Annotation tag
forall k (tag :: k). Annotation tag
noAnn then [] else Element [Annotation tag]
Annotation tag
a Annotation tag -> [Annotation tag] -> [Annotation tag]
forall a. a -> [a] -> [a]
: [Annotation tag]
lst) []
annsCount :: AnnotationSet -> (Int, Int, Int)
annsCount :: AnnotationSet -> (Int, Int, Int)
annsCount (AnnotationSet [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas) = ([TypeAnn] -> Int
forall t. Container t => t -> Int
length [TypeAnn]
tas, [FieldAnn] -> Int
forall t. Container t => t -> Int
length [FieldAnn]
fas, [VarAnn] -> Int
forall t. Container t => t -> Int
length [VarAnn]
vas)
firstAnn :: (KnownAnnTag tag) => AnnotationSet -> Annotation tag
firstAnn :: AnnotationSet -> Annotation tag
firstAnn = ([Annotation tag] -> Annotation tag)
-> AnnotationSet -> Annotation tag
forall tag.
KnownAnnTag tag =>
([Annotation tag] -> Annotation tag)
-> AnnotationSet -> Annotation tag
getAnn (\case [] -> Annotation tag
forall k (tag :: k). Annotation tag
noAnn; Annotation tag
a : [Annotation tag]
_ -> Annotation tag
a)
secondAnn :: (KnownAnnTag tag) => AnnotationSet -> Annotation tag
secondAnn :: AnnotationSet -> Annotation tag
secondAnn = ([Annotation tag] -> Annotation tag)
-> AnnotationSet -> Annotation tag
forall tag.
KnownAnnTag tag =>
([Annotation tag] -> Annotation tag)
-> AnnotationSet -> Annotation tag
getAnn (\case [] -> Annotation tag
forall k (tag :: k). Annotation tag
noAnn; [Annotation tag
_] -> Annotation tag
forall k (tag :: k). Annotation tag
noAnn; Annotation tag
_ : Annotation tag
a : [Annotation tag]
_ -> Annotation tag
a)
getAnn :: forall tag. (KnownAnnTag tag)
=> ([Annotation tag] -> Annotation tag)
-> AnnotationSet
-> Annotation tag
getAnn :: ([Annotation tag] -> Annotation tag)
-> AnnotationSet -> Annotation tag
getAnn [Annotation tag] -> Annotation tag
getter AnnotationSet
annSet = case (Typeable tag, Typeable TypeTag) => Maybe (tag :~: TypeTag)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @tag @TypeTag of
Just tag :~: TypeTag
Refl -> [Annotation tag] -> Annotation tag
getter ([Annotation tag] -> Annotation tag)
-> [Annotation tag] -> Annotation tag
forall a b. (a -> b) -> a -> b
$ AnnotationSet -> [TypeAnn]
asTypes AnnotationSet
annSet
Maybe (tag :~: TypeTag)
Nothing -> case (Typeable tag, Typeable FieldTag) => Maybe (tag :~: FieldTag)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @tag @FieldTag of
Just tag :~: FieldTag
Refl -> [Annotation tag] -> Annotation tag
getter ([Annotation tag] -> Annotation tag)
-> [Annotation tag] -> Annotation tag
forall a b. (a -> b) -> a -> b
$ AnnotationSet -> [FieldAnn]
asFields AnnotationSet
annSet
Maybe (tag :~: FieldTag)
Nothing -> case (Typeable tag, Typeable VarTag) => Maybe (tag :~: VarTag)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @tag @VarTag of
Just tag :~: VarTag
Refl -> [Annotation tag] -> Annotation tag
getter ([Annotation tag] -> Annotation tag)
-> [Annotation tag] -> Annotation tag
forall a b. (a -> b) -> a -> b
$ AnnotationSet -> [VarAnn]
asVars AnnotationSet
annSet
Maybe (tag :~: VarTag)
Nothing -> Text -> Annotation tag
forall a. HasCallStack => Text -> a
error Text
"Impossible"
class Typeable (tag :: Type) => KnownAnnTag tag where
annPrefix :: Text
instance KnownAnnTag tag => Show (Annotation tag) where
show :: Annotation tag -> String
show = Bool -> Doc -> String
printDocS Bool
True (Doc -> String)
-> (Annotation tag -> Doc) -> Annotation tag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> Annotation tag -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens
data TypeTag
data FieldTag
data VarTag
data SomeTag
type TypeAnn = Annotation TypeTag
type FieldAnn = Annotation FieldTag
type VarAnn = Annotation VarTag
type SomeAnn = Annotation SomeTag
type RootAnn = Annotation FieldTag
instance KnownAnnTag FieldTag where
annPrefix :: Text
annPrefix = Text
"%"
instance KnownAnnTag VarTag where
annPrefix :: Text
annPrefix = Text
"@"
instance KnownAnnTag TypeTag where
annPrefix :: Text
annPrefix = Text
":"
instance KnownAnnTag tag => RenderDoc (Annotation tag) where
renderDoc :: RenderContext -> Annotation tag -> Doc
renderDoc RenderContext
_ = Annotation tag -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnn
instance KnownAnnTag tag => Buildable (Annotation tag) where
build :: Annotation tag -> Builder
build = Annotation tag -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
instance Show AnnotationSet where
show :: AnnotationSet -> String
show = Bool -> Doc -> String
printDocS Bool
True (Doc -> String)
-> (AnnotationSet -> Doc) -> AnnotationSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> AnnotationSet -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens
instance RenderDoc AnnotationSet where
renderDoc :: RenderContext -> AnnotationSet -> Doc
renderDoc RenderContext
_ (AnnotationSet {[VarAnn]
[FieldAnn]
[TypeAnn]
asVars :: [VarAnn]
asFields :: [FieldAnn]
asTypes :: [TypeAnn]
asVars :: AnnotationSet -> [VarAnn]
asFields :: AnnotationSet -> [FieldAnn]
asTypes :: AnnotationSet -> [TypeAnn]
..}) =
[TypeAnn] -> Doc
forall tag. KnownAnnTag tag => [Annotation tag] -> Doc
renderAnnGroup [TypeAnn]
asTypes Doc -> Doc -> Doc
<+> [FieldAnn] -> Doc
forall tag. KnownAnnTag tag => [Annotation tag] -> Doc
renderAnnGroup [FieldAnn]
asFields Doc -> Doc -> Doc
<+> [VarAnn] -> Doc
forall tag. KnownAnnTag tag => [Annotation tag] -> Doc
renderAnnGroup [VarAnn]
asVars
instance Buildable AnnotationSet where
build :: AnnotationSet -> Builder
build = AnnotationSet -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
renderAnn :: forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnn :: Annotation tag -> Doc
renderAnn (Annotation Text
text) = Text -> Doc
textStrict (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ KnownAnnTag tag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
renderAnnGroup :: KnownAnnTag tag => [Annotation tag] -> Doc
renderAnnGroup :: [Annotation tag] -> Doc
renderAnnGroup = [Doc] -> Doc
hsep ([Doc] -> Doc)
-> ([Annotation tag] -> [Doc]) -> [Annotation tag] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotation tag -> Doc) -> [Annotation tag] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Annotation tag -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnn ([Annotation tag] -> [Doc])
-> ([Annotation tag] -> [Annotation tag])
-> [Annotation tag]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Annotation tag] -> [Annotation tag]
forall k (tag :: k). [Annotation tag] -> [Annotation tag]
trimEndNoAnn
noAnn :: Annotation a
noAnn :: Annotation a
noAnn = Text -> Annotation a
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation Text
""
unsafeMkAnnotation :: HasCallStack => Text -> Annotation a
unsafeMkAnnotation :: Text -> Annotation a
unsafeMkAnnotation = (Text -> Annotation a)
-> (Annotation a -> Annotation a)
-> Either Text (Annotation a)
-> Annotation a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Annotation a
forall a. HasCallStack => Text -> a
error Annotation a -> Annotation a
forall a. a -> a
id (Either Text (Annotation a) -> Annotation a)
-> (Text -> Either Text (Annotation a)) -> Text -> Annotation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Annotation a)
forall k (a :: k). Text -> Either Text (Annotation a)
mkAnnotation
mkAnnotation :: Text -> Either Text (Annotation a)
mkAnnotation :: Text -> Either Text (Annotation a)
mkAnnotation Text
text
| Text
Element [Text]
text Element [Text] -> [Text] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [Text]
specialVarAnns = Annotation a -> Either Text (Annotation a)
forall a b. b -> Either a b
Right (Annotation a -> Either Text (Annotation a))
-> Annotation a -> Either Text (Annotation a)
forall a b. (a -> b) -> a -> b
$ Text -> Annotation a
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation Text
text
| Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
specialFieldAnn = Annotation a -> Either Text (Annotation a)
forall a b. b -> Either a b
Right (Annotation a -> Either Text (Annotation a))
-> Annotation a -> Either Text (Annotation a)
forall a b. (a -> b) -> a -> b
$ Text -> Annotation a
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation Text
text
| Bool
otherwise = do
Text
suffix <- case Text -> Maybe (Char, Text)
T.uncons Text
text of
Just (Char
h, Text
tl) | Char -> Bool
isValidAnnStart Char
h -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
tl
Just (Char
h, Text
_) -> Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Text
"Invalid first character: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OneItem Text -> Text
forall x. One x => OneItem x -> x
one Char
OneItem Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
Maybe (Char, Text)
_ -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
""
Either Text (Annotation a)
-> (Char -> Either Text (Annotation a))
-> Maybe Char
-> Either Text (Annotation a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Annotation a -> Either Text (Annotation a)
forall a b. b -> Either a b
Right (Annotation a -> Either Text (Annotation a))
-> Annotation a -> Either Text (Annotation a)
forall a b. (a -> b) -> a -> b
$ Text -> Annotation a
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation Text
text) (\Char
c -> Text -> Either Text (Annotation a)
forall a b. a -> Either a b
Left (Text -> Either Text (Annotation a))
-> Text -> Either Text (Annotation a)
forall a b. (a -> b) -> a -> b
$ Text
"Invalid character: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OneItem Text -> Text
forall x. One x => OneItem x -> x
one Char
OneItem Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") (Maybe Char -> Either Text (Annotation a))
-> Maybe Char -> Either Text (Annotation a)
forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Text -> Maybe Char
T.find (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isValidAnnBodyChar) Text
suffix
annQ :: TH.QuasiQuoter
annQ :: QuasiQuoter
annQ = Maybe TypeQ -> QuasiQuoter
annQImpl Maybe TypeQ
forall a. Maybe a
Nothing
typeAnnQ :: TH.QuasiQuoter
typeAnnQ :: QuasiQuoter
typeAnnQ = Maybe TypeQ -> QuasiQuoter
annQImpl (TypeQ -> Maybe TypeQ
forall a. a -> Maybe a
Just [t|TypeAnn|])
fieldAnnQ :: TH.QuasiQuoter
fieldAnnQ :: QuasiQuoter
fieldAnnQ = Maybe TypeQ -> QuasiQuoter
annQImpl (TypeQ -> Maybe TypeQ
forall a. a -> Maybe a
Just [t|FieldAnn|])
varAnnQ :: TH.QuasiQuoter
varAnnQ :: QuasiQuoter
varAnnQ = Maybe TypeQ -> QuasiQuoter
annQImpl (TypeQ -> Maybe TypeQ
forall a. a -> Maybe a
Just [t|VarAnn|])
annQImpl :: Maybe TH.TypeQ -> TH.QuasiQuoter
annQImpl :: Maybe TypeQ -> QuasiQuoter
annQImpl Maybe TypeQ
annTypeMb = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> TypeQ)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
{
quoteExp :: String -> Q Exp
TH.quoteExp = \String
s ->
case (Text -> Either Text (Annotation Any)
forall k (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> Either Text (Annotation Any))
-> Text -> Either Text (Annotation Any)
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText @String String
s) of
Left Text
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
err
Right Annotation Any
_ -> case Maybe TypeQ
annTypeMb of
Maybe TypeQ
Nothing -> [e| (UnsafeAnnotation s) |]
Just TypeQ
annType -> [e| (UnsafeAnnotation s :: $(annType)) |]
, quotePat :: String -> Q Pat
TH.quotePat = \String
s ->
case (Text -> Either Text (Annotation Any)
forall k (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> Either Text (Annotation Any))
-> Text -> Either Text (Annotation Any)
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText @String String
s) of
Left Text
err -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Pat) -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
err
Right Annotation Any
_ -> case Maybe TypeQ
annTypeMb of
Maybe TypeQ
Nothing -> [p| UnsafeAnnotation $(TH.litP $ TH.StringL s) |]
Just TypeQ
annType -> [p| (UnsafeAnnotation $(TH.litP $ TH.StringL s) :: $(annType)) |]
, quoteType :: String -> TypeQ
TH.quoteType = \String
_ -> String -> TypeQ
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use this QuasiQuoter at type position"
, quoteDec :: String -> Q [Dec]
TH.quoteDec = \String
_ -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use this QuasiQuoter at declaration position"
}
specialVarAnns :: [Text]
specialVarAnns :: [Text]
specialVarAnns = [Text
"%%",Text
"%"]
specialFieldAnn :: Text
specialFieldAnn :: Text
specialFieldAnn = Text
"@"
isValidAnnStart :: Char -> Bool
isValidAnnStart :: Char -> Bool
isValidAnnStart Char
x = (Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& (Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Char -> Bool
isDigit Char
x)) Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
isValidAnnBodyChar :: Char -> Bool
isValidAnnBodyChar :: Char -> Bool
isValidAnnBodyChar Char
x =
Char -> Bool
isValidAnnStart Char
x Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| (Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Char -> Bool
isNumber Char
x) Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Char
Element String
x Element String -> String -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` (String
".%@" :: String)
instance Semigroup VarAnn where
Annotation Text
a <> :: VarAnn -> VarAnn -> VarAnn
<> Annotation Text
b
| Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Text -> VarAnn
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation (Text -> VarAnn) -> Text -> VarAnn
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
| Bool
otherwise = Text -> VarAnn
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation (Text -> VarAnn) -> Text -> VarAnn
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
instance Monoid VarAnn where
mempty :: VarAnn
mempty = VarAnn
forall k (tag :: k). Annotation tag
noAnn
orAnn :: Annotation t -> Annotation t -> Annotation t
orAnn :: Annotation t -> Annotation t -> Annotation t
orAnn Annotation t
a Annotation t
b = Annotation t -> Annotation t -> Bool -> Annotation t
forall a. a -> a -> Bool -> a
bool Annotation t
a Annotation t
b (Annotation t
a Annotation t -> Annotation t -> Bool
forall a. Eq a => a -> a -> Bool
== Annotation t
forall a. Default a => a
def)
unifyAnn :: Annotation tag -> Annotation tag -> Maybe (Annotation tag)
unifyAnn :: Annotation tag -> Annotation tag -> Maybe (Annotation tag)
unifyAnn a :: Annotation tag
a@(Annotation Text
ann1) (Annotation Text
ann2)
| Text
ann1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Text
ann2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Annotation tag -> Maybe (Annotation tag)
forall a. a -> Maybe a
Just Annotation tag
forall k (tag :: k). Annotation tag
noAnn
| Text
ann1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ann2 = Annotation tag -> Maybe (Annotation tag)
forall a. a -> Maybe a
Just (Annotation tag -> Maybe (Annotation tag))
-> Annotation tag -> Maybe (Annotation tag)
forall a b. (a -> b) -> a -> b
$ Annotation tag
a
| Bool
otherwise = Maybe (Annotation tag)
forall a. Maybe a
Nothing
unifyPairFieldAnn :: FieldAnn -> FieldAnn -> Maybe FieldAnn
unifyPairFieldAnn :: FieldAnn -> FieldAnn -> Maybe FieldAnn
unifyPairFieldAnn a1 :: FieldAnn
a1@(Annotation Text
ann1) a2 :: FieldAnn
a2@(Annotation Text
ann2)
| Text
ann1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Text
ann2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = FieldAnn -> Maybe FieldAnn
forall a. a -> Maybe a
Just (FieldAnn -> Maybe FieldAnn) -> FieldAnn -> Maybe FieldAnn
forall a b. (a -> b) -> a -> b
$ FieldAnn
a1 FieldAnn -> FieldAnn -> FieldAnn
forall k (t :: k). Annotation t -> Annotation t -> Annotation t
`orAnn` FieldAnn
a2
| Text
ann1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ann2 = FieldAnn -> Maybe FieldAnn
forall a. a -> Maybe a
Just FieldAnn
a1
| Bool
otherwise = Maybe FieldAnn
forall a. Maybe a
Nothing
convergeVarAnns :: VarAnn -> VarAnn -> VarAnn
convergeVarAnns :: VarAnn -> VarAnn -> VarAnn
convergeVarAnns VarAnn
ann1 VarAnn
ann2
| VarAnn
ann1 VarAnn -> VarAnn -> Bool
forall a. Eq a => a -> a -> Bool
== VarAnn
ann2 = VarAnn
ann1
| Bool
otherwise = VarAnn
forall k (tag :: k). Annotation tag
noAnn
ifAnnUnified :: Annotation tag -> Annotation tag -> Bool
ifAnnUnified :: Annotation tag -> Annotation tag -> Bool
ifAnnUnified Annotation tag
a1 Annotation tag
a2 = Maybe (Annotation tag) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Annotation tag) -> Bool) -> Maybe (Annotation tag) -> Bool
forall a b. (a -> b) -> a -> b
$ Annotation tag
a1 Annotation tag -> Annotation tag -> Maybe (Annotation tag)
forall k (tag :: k).
Annotation tag -> Annotation tag -> Maybe (Annotation tag)
`unifyAnn` Annotation tag
a2
convAnn :: Annotation tag1 -> Annotation tag2
convAnn :: Annotation tag1 -> Annotation tag2
convAnn (Annotation Text
a) = Text -> Annotation tag2
forall k (tag :: k). Text -> Annotation tag
UnsafeAnnotation Text
a
pattern WithAnn :: Annotation tag -> Annotation tag
pattern $mWithAnn :: forall r k (tag :: k).
Annotation tag -> (Annotation tag -> r) -> (Void# -> r) -> r
WithAnn ann <- ann@(Annotation (toString -> _:_))
deriveJSON morleyAesonOptions ''Annotation
deriveLift ''Annotation