{-# LANGUAGE PatternSynonyms #-}
module Language.Jsonnet.Annotate where
import Control.Applicative (Const (..))
import Data.Fix
import Data.Functor.Product
type AnnF f a = Product (Const a) f
type Ann f a = Fix (AnnF f a)
pattern $bAnnF :: forall {a1} {g :: * -> *} {a2}.
g a2 -> a1 -> Product (Const a1) g a2
$mAnnF :: forall {r} {a1} {g :: * -> *} {a2}.
Product (Const a1) g a2 -> (g a2 -> a1 -> r) -> (Void# -> r) -> r
AnnF f a = Pair (Const a) f
annMap :: Functor f => (a -> b) -> Ann f a -> Ann f b
annMap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Ann f a -> Ann f b
annMap a -> b
g = Fix (Product (Const a) f) -> Fix (Product (Const b) f)
forall {g :: * -> *}.
Functor g =>
Fix (Product (Const a) g) -> Fix (Product (Const b) g)
go
where
go :: Fix (Product (Const a) g) -> Fix (Product (Const b) g)
go (Fix (AnnF g (Fix (Product (Const a) g))
f a
a)) = Product (Const b) g (Fix (Product (Const b) g))
-> Fix (Product (Const b) g)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Product (Const b) g (Fix (Product (Const b) g))
-> Fix (Product (Const b) g))
-> Product (Const b) g (Fix (Product (Const b) g))
-> Fix (Product (Const b) g)
forall a b. (a -> b) -> a -> b
$ g (Fix (Product (Const b) g))
-> b -> Product (Const b) g (Fix (Product (Const b) g))
forall {a1} {g :: * -> *} {a2}.
g a2 -> a1 -> Product (Const a1) g a2
AnnF ((Fix (Product (Const a) g) -> Fix (Product (Const b) g))
-> g (Fix (Product (Const a) g)) -> g (Fix (Product (Const b) g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix (Product (Const a) g) -> Fix (Product (Const b) g)
go g (Fix (Product (Const a) g))
f) (a -> b
g a
a)
forget :: Functor f => Ann f a -> Fix f
forget :: forall (f :: * -> *) a. Functor f => Ann f a -> Fix f
forget (Fix (AnnF f (Fix (AnnF f a))
f a
_)) = f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix f) -> Fix f) -> f (Fix f) -> Fix f
forall a b. (a -> b) -> a -> b
$ (Fix (AnnF f a) -> Fix f) -> f (Fix (AnnF f a)) -> f (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix (AnnF f a) -> Fix f
forall (f :: * -> *) a. Functor f => Ann f a -> Fix f
forget f (Fix (AnnF f a))
f
attrib :: Ann f a -> a
attrib :: forall (f :: * -> *) a. Ann f a -> a
attrib (Fix (AnnF f (Fix (AnnF f a))
_ a
a)) = a
a
inherit :: Functor f => (Fix f -> a -> (b, a)) -> a -> Fix f -> Ann f b
inherit :: forall (f :: * -> *) a b.
Functor f =>
(Fix f -> a -> (b, a)) -> a -> Fix f -> Ann f b
inherit Fix f -> a -> (b, a)
h = a -> Fix f -> Fix (Product (Const b) f)
go
where
go :: a -> Fix f -> Fix (Product (Const b) f)
go a
p s :: Fix f
s@(Fix f (Fix f)
t) =
let (b
b, a
a) =
Fix f -> a -> (b, a)
h Fix f
s a
p
in Product (Const b) f (Fix (Product (Const b) f))
-> Fix (Product (Const b) f)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix (Product (Const b) f))
-> b -> Product (Const b) f (Fix (Product (Const b) f))
forall {a1} {g :: * -> *} {a2}.
g a2 -> a1 -> Product (Const a1) g a2
AnnF ((Fix f -> Fix (Product (Const b) f))
-> f (Fix f) -> f (Fix (Product (Const b) f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Fix f -> Fix (Product (Const b) f)
go a
a) f (Fix f)
t) b
b)
annZip :: Functor f => Fix (AnnF (AnnF f a) b) -> Ann f (a, b)
annZip :: forall (f :: * -> *) a b.
Functor f =>
Fix (AnnF (AnnF f a) b) -> Ann f (a, b)
annZip (Fix (AnnF (AnnF f (Fix (AnnF (AnnF f a) b))
t a
x) b
y)) = Product (Const (a, b)) f (Fix (Product (Const (a, b)) f))
-> Fix (Product (Const (a, b)) f)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix (Product (Const (a, b)) f))
-> (a, b)
-> Product (Const (a, b)) f (Fix (Product (Const (a, b)) f))
forall {a1} {g :: * -> *} {a2}.
g a2 -> a1 -> Product (Const a1) g a2
AnnF ((Fix (AnnF (AnnF f a) b) -> Fix (Product (Const (a, b)) f))
-> f (Fix (AnnF (AnnF f a) b))
-> f (Fix (Product (Const (a, b)) f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix (AnnF (AnnF f a) b) -> Fix (Product (Const (a, b)) f)
forall (f :: * -> *) a b.
Functor f =>
Fix (AnnF (AnnF f a) b) -> Ann f (a, b)
annZip f (Fix (AnnF (AnnF f a) b))
t) (a
x, b
y))