module UVMHS.Lib.THLiftInstances where

import UVMHS.Core
import UVMHS.Lib.Annotated
import UVMHS.Lib.Parser
import UVMHS.Lib.Pretty
import UVMHS.Lib.TreeAnnote
import UVMHS.Lib.Variables
import UVMHS.Lib.Window

import qualified Language.Haskell.TH.Syntax as TH

deriving instance (TH.Lift a) ⇒ TH.Lift (AddBT a)
deriving instance (TH.Lift i,TH.Lift a) ⇒ TH.Lift (WindowL i a)
deriving instance (TH.Lift i,TH.Lift a) ⇒ TH.Lift (WindowR i a)
deriving instance TH.Lift SrcCxt
deriving instance TH.Lift LocRange
deriving instance (TH.Lift 𝒸,TH.Lift a) ⇒ TH.Lift (𝐴 𝒸 a)
deriving instance TH.Lift Loc
deriving instance TH.Lift 𝕏
deriving instance TH.Lift 𝕐
deriving instance (TH.Lift a,TH.Lift b) ⇒ TH.Lift (a ∧ b)
deriving instance TH.Lift Annotation
deriving instance TH.Lift Formats
deriving instance TH.Lift Color
deriving instance TH.Lift Color3Bit
deriving instance TH.Lift ChunkI
deriving instance (TH.Lift a) ⇒ TH.Lift (𝑂 a)
deriving instance (TH.Lift i,TH.Lift a) ⇒ TH.Lift (𝑇 i a)

instance (TH.Lift i,TH.Lift a) ⇒ TH.Lift (𝑇V i a) where
  liftTyped :: forall (m :: * -> *). Quote m => 𝑇V i a -> Code m (𝑇V i a)
liftTyped 𝑇V i a
t = do
    let t' :: 𝑇 i a
t' = (a -> 𝑇 i a) -> (i -> 𝑇 i a -> 𝑇 i a) -> 𝑇V i a -> 𝑇 i a
forall b a i. Monoid b => (a -> b) -> (i -> b -> b) -> 𝑇V i a -> b
fold𝑇VWith a -> 𝑇 i a
forall a t. Single a t => a -> t
single i -> 𝑇 i a -> 𝑇 i a
forall i a. Annote i a => i -> a -> a
annote 𝑇V i a
t
    [|| (a -> b) -> (i -> b -> b) -> 𝑇 i a -> b
forall b a i. Monoid b => (a -> b) -> (i -> b -> b) -> 𝑇 i a -> b
fold𝑇With a -> t
forall a t. Single a t => a -> t
single i -> a -> a
forall i a. Annote i a => i -> a -> a
annote a
t' ||]

instance (TH.Lift a) ⇒ TH.Lift (𝐼 a) where
  liftTyped :: forall (m :: * -> *). Quote m => 𝐼 a -> Code m (𝐼 a)
liftTyped 𝐼 a
xs = do
    let xs' :: 𝐿 a
xs' = 𝐼 a -> 𝐿 a
forall a t. ToIter a t => t -> 𝐿 a
list 𝐼 a
xs
    [|| t -> 𝐼 a
forall a t. ToIter a t => t -> 𝐼 a
iter 𝐿 a
xs' ||]

instance TH.Lift Doc where
  liftTyped :: forall (m :: * -> *). Quote m => Doc -> Code m Doc
liftTyped Doc
d = do
    let d' :: TreeI
d' = Doc -> TreeI
ppBake Doc
d
    [|| TreeI -> Doc
ppEmbed TreeI
d' ||]