{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia   #-}
{-# LANGUAGE StrictData    #-}
{-# LANGUAGE TypeOperators #-}
module Language.Cimple.Annot
    ( AnnotF (..)
    , AnnotNode
    , addAnnot
    , removeAnnot
    ) where

import           Data.Fix                     (Fix, hoistFix)
import           Data.Functor.Classes         (Eq1, Read1, Show1)
import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))
import           Data.Functor.Compose         (Compose (..))
import           GHC.Generics                 (Generic, Generic1)
import           Language.Cimple.Ast          (Node, NodeF)

data AnnotF attr a = Annot { AnnotF attr a -> attr
attr :: attr, AnnotF attr a -> a
unAnnot :: a }
    deriving (a -> AnnotF attr b -> AnnotF attr a
(a -> b) -> AnnotF attr a -> AnnotF attr b
(forall a b. (a -> b) -> AnnotF attr a -> AnnotF attr b)
-> (forall a b. a -> AnnotF attr b -> AnnotF attr a)
-> Functor (AnnotF attr)
forall a b. a -> AnnotF attr b -> AnnotF attr a
forall a b. (a -> b) -> AnnotF attr a -> AnnotF attr b
forall attr a b. a -> AnnotF attr b -> AnnotF attr a
forall attr a b. (a -> b) -> AnnotF attr a -> AnnotF attr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AnnotF attr b -> AnnotF attr a
$c<$ :: forall attr a b. a -> AnnotF attr b -> AnnotF attr a
fmap :: (a -> b) -> AnnotF attr a -> AnnotF attr b
$cfmap :: forall attr a b. (a -> b) -> AnnotF attr a -> AnnotF attr b
Functor, (forall x. AnnotF attr a -> Rep (AnnotF attr a) x)
-> (forall x. Rep (AnnotF attr a) x -> AnnotF attr a)
-> Generic (AnnotF attr a)
forall x. Rep (AnnotF attr a) x -> AnnotF attr a
forall x. AnnotF attr a -> Rep (AnnotF attr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall attr a x. Rep (AnnotF attr a) x -> AnnotF attr a
forall attr a x. AnnotF attr a -> Rep (AnnotF attr a) x
$cto :: forall attr a x. Rep (AnnotF attr a) x -> AnnotF attr a
$cfrom :: forall attr a x. AnnotF attr a -> Rep (AnnotF attr a) x
Generic, (forall a. AnnotF attr a -> Rep1 (AnnotF attr) a)
-> (forall a. Rep1 (AnnotF attr) a -> AnnotF attr a)
-> Generic1 (AnnotF attr)
forall a. Rep1 (AnnotF attr) a -> AnnotF attr a
forall a. AnnotF attr a -> Rep1 (AnnotF attr) a
forall attr a. Rep1 (AnnotF attr) a -> AnnotF attr a
forall attr a. AnnotF attr a -> Rep1 (AnnotF attr) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall attr a. Rep1 (AnnotF attr) a -> AnnotF attr a
$cfrom1 :: forall attr a. AnnotF attr a -> Rep1 (AnnotF attr) a
Generic1)
    deriving ((Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AnnotF attr a -> ShowS
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [AnnotF attr a] -> ShowS
(forall a.
 (Int -> a -> ShowS)
 -> ([a] -> ShowS) -> Int -> AnnotF attr a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [AnnotF attr a] -> ShowS)
-> Show1 (AnnotF attr)
forall attr a.
Show attr =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AnnotF attr a -> ShowS
forall attr a.
Show attr =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [AnnotF attr a] -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AnnotF attr a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [AnnotF attr a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [AnnotF attr a] -> ShowS
$cliftShowList :: forall attr a.
Show attr =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [AnnotF attr a] -> ShowS
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AnnotF attr a -> ShowS
$cliftShowsPrec :: forall attr a.
Show attr =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AnnotF attr a -> ShowS
Show1, ReadPrec a -> ReadPrec [a] -> ReadPrec (AnnotF attr a)
ReadPrec a -> ReadPrec [a] -> ReadPrec [AnnotF attr a]
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (AnnotF attr a)
(Int -> ReadS a) -> ReadS [a] -> ReadS [AnnotF attr a]
(forall a.
 (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (AnnotF attr a))
-> (forall a.
    (Int -> ReadS a) -> ReadS [a] -> ReadS [AnnotF attr a])
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec (AnnotF attr a))
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec [AnnotF attr a])
-> Read1 (AnnotF attr)
forall attr a.
Read attr =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [AnnotF attr a]
forall attr a.
Read attr =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (AnnotF attr a)
forall attr a.
Read attr =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (AnnotF attr a)
forall attr a.
Read attr =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [AnnotF attr a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [AnnotF attr a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (AnnotF attr a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (AnnotF attr a)
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [AnnotF attr a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [AnnotF attr a]
$cliftReadListPrec :: forall attr a.
Read attr =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [AnnotF attr a]
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (AnnotF attr a)
$cliftReadPrec :: forall attr a.
Read attr =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (AnnotF attr a)
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [AnnotF attr a]
$cliftReadList :: forall attr a.
Read attr =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [AnnotF attr a]
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (AnnotF attr a)
$cliftReadsPrec :: forall attr a.
Read attr =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (AnnotF attr a)
Read1, (a -> b -> Bool) -> AnnotF attr a -> AnnotF attr b -> Bool
(forall a b.
 (a -> b -> Bool) -> AnnotF attr a -> AnnotF attr b -> Bool)
-> Eq1 (AnnotF attr)
forall attr a b.
Eq attr =>
(a -> b -> Bool) -> AnnotF attr a -> AnnotF attr b -> Bool
forall a b.
(a -> b -> Bool) -> AnnotF attr a -> AnnotF attr b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: (a -> b -> Bool) -> AnnotF attr a -> AnnotF attr b -> Bool
$cliftEq :: forall attr a b.
Eq attr =>
(a -> b -> Bool) -> AnnotF attr a -> AnnotF attr b -> Bool
Eq1) via FunctorClassesDefault (AnnotF attr)

type AnnotNode lexeme = Fix (AnnotF () `Compose` NodeF lexeme)

addAnnot :: Node lexeme -> AnnotNode lexeme
addAnnot :: Node lexeme -> AnnotNode lexeme
addAnnot = (forall a. NodeF lexeme a -> Compose (AnnotF ()) (NodeF lexeme) a)
-> Node lexeme -> AnnotNode lexeme
forall (f :: * -> *) (g :: * -> *).
Functor f =>
(forall a. f a -> g a) -> Fix f -> Fix g
hoistFix ((forall a. NodeF lexeme a -> Compose (AnnotF ()) (NodeF lexeme) a)
 -> Node lexeme -> AnnotNode lexeme)
-> (forall a.
    NodeF lexeme a -> Compose (AnnotF ()) (NodeF lexeme) a)
-> Node lexeme
-> AnnotNode lexeme
forall a b. (a -> b) -> a -> b
$ AnnotF () (NodeF lexeme a) -> Compose (AnnotF ()) (NodeF lexeme) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (AnnotF () (NodeF lexeme a)
 -> Compose (AnnotF ()) (NodeF lexeme) a)
-> (NodeF lexeme a -> AnnotF () (NodeF lexeme a))
-> NodeF lexeme a
-> Compose (AnnotF ()) (NodeF lexeme) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> NodeF lexeme a -> AnnotF () (NodeF lexeme a)
forall attr a. attr -> a -> AnnotF attr a
Annot ()

removeAnnot :: AnnotNode lexeme -> Node lexeme
removeAnnot :: AnnotNode lexeme -> Node lexeme
removeAnnot = (forall a. Compose (AnnotF ()) (NodeF lexeme) a -> NodeF lexeme a)
-> AnnotNode lexeme -> Node lexeme
forall (f :: * -> *) (g :: * -> *).
Functor f =>
(forall a. f a -> g a) -> Fix f -> Fix g
hoistFix ((forall a. Compose (AnnotF ()) (NodeF lexeme) a -> NodeF lexeme a)
 -> AnnotNode lexeme -> Node lexeme)
-> (forall a.
    Compose (AnnotF ()) (NodeF lexeme) a -> NodeF lexeme a)
-> AnnotNode lexeme
-> Node lexeme
forall a b. (a -> b) -> a -> b
$ AnnotF () (NodeF lexeme a) -> NodeF lexeme a
forall attr a. AnnotF attr a -> a
unAnnot (AnnotF () (NodeF lexeme a) -> NodeF lexeme a)
-> (Compose (AnnotF ()) (NodeF lexeme) a
    -> AnnotF () (NodeF lexeme a))
-> Compose (AnnotF ()) (NodeF lexeme) a
-> NodeF lexeme a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (AnnotF ()) (NodeF lexeme) a -> AnnotF () (NodeF lexeme a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose