{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef ONLY_ONE_LANGUAGE
module Cubix.Language.Python.Parametric.Full.Trans () where
#else
module Cubix.Language.Python.Parametric.Full.Trans (
translate
, untranslate
) where
import Data.Proxy
import Data.Typeable (Typeable )
import Data.Comp.Multi ( caseCxt, Sum, All )
import qualified Language.Python.Common.AST as P
import qualified Language.Haskell.TH as TH
import Data.Comp.Trans ( runCompTrans, withSubstitutions, deriveTrans, deriveUntrans )
import Cubix.Language.Python.Parametric.Full.Names
import Cubix.Language.Python.Parametric.Full.Types
import Cubix.Language.Parametric.Syntax.Base
import Cubix.Language.Parametric.Syntax.Functor
do substs <- makeSubsts
runCompTrans $ withSubstitutions substs $ deriveTrans origASTTypes (TH.ConT ''PythonTerm)
translate :: P.Module () -> PythonTerm ModuleL
translate :: Module () -> PythonTerm ModuleL
translate = Module () -> PythonTerm ModuleL
forall a i. Trans a i => a -> PythonTerm i
trans
instance (Trans c l, Typeable l) => Trans [c] [l] where
trans :: [c] -> PythonTerm [l]
trans [] = PythonTerm [l]
forall h (f :: (* -> *) -> * -> *) (a :: * -> *) l.
(ListF :<: f, Typeable l) =>
Cxt h f a [l]
riNilF
trans (x :: c
x:xs :: [c]
xs) = (c -> PythonTerm l
forall a i. Trans a i => a -> PythonTerm i
trans c
x :: PythonTerm l) PythonTerm l -> PythonTerm [l] -> PythonTerm [l]
forall (fs :: [(* -> *) -> * -> *]) l l' h (a :: * -> *).
(ListF :-<: fs, InjF fs [l] l', Typeable l) =>
CxtS h fs a l -> CxtS h fs a [l] -> CxtS h fs a l'
`iConsF` ([c] -> PythonTerm [l]
forall a i. Trans a i => a -> PythonTerm i
trans [c]
xs)
instance (Trans c l, Typeable l) => Trans (Maybe c) (Maybe l) where
trans :: Maybe c -> PythonTerm (Maybe l)
trans Nothing = PythonTerm (Maybe l)
forall h (f :: (* -> *) -> * -> *) (a :: * -> *) l.
(MaybeF :<: f, Typeable l) =>
Cxt h f a (Maybe l)
riNothingF
trans (Just x :: c
x) = CxtS NoHole PythonSig (K ()) l -> PythonTerm (Maybe l)
forall (fs :: [(* -> *) -> * -> *]) l l' h (a :: * -> *).
(MaybeF :-<: fs, InjF fs (Maybe l) l', Typeable l) =>
CxtS h fs a l -> CxtS h fs a l'
iJustF (CxtS NoHole PythonSig (K ()) l -> PythonTerm (Maybe l))
-> CxtS NoHole PythonSig (K ()) l -> PythonTerm (Maybe l)
forall a b. (a -> b) -> a -> b
$ (c -> CxtS NoHole PythonSig (K ()) l
forall a i. Trans a i => a -> PythonTerm i
trans c
x :: PythonTerm l)
instance (Trans c l, Trans d l', Typeable l, Typeable l') => Trans (c, d) (l, l') where
trans :: (c, d) -> PythonTerm (l, l')
trans (x :: c
x, y :: d
y) = Cxt NoHole (Sum PythonSig) (K ()) l
-> Cxt NoHole (Sum PythonSig) (K ()) l' -> PythonTerm (l, l')
forall (f :: (* -> *) -> * -> *) i j h (a :: * -> *).
(PairF :<: f, Typeable i, Typeable j) =>
Cxt h f a i -> Cxt h f a j -> Cxt h f a (i, j)
riPairF (c -> Cxt NoHole (Sum PythonSig) (K ()) l
forall a i. Trans a i => a -> PythonTerm i
trans c
x) (d -> Cxt NoHole (Sum PythonSig) (K ()) l'
forall a i. Trans a i => a -> PythonTerm i
trans d
y)
instance Trans Char CharL where
trans :: Char -> PythonTerm CharL
trans c :: Char
c = Char -> PythonTerm CharL
forall h (fs :: [(* -> *) -> * -> *]) (a :: * -> *) j.
(CharF :-<: fs, InjF fs CharL j) =>
Char -> CxtS h fs a j
iCharF Char
c
instance Trans () () where
trans :: () -> PythonTerm ()
trans _ = PythonTerm ()
forall h (fs :: [(* -> *) -> * -> *]) (a :: * -> *) j.
(UnitF :-<: fs, InjF fs () j) =>
CxtS h fs a j
iUnitF
do substs <- makeSubsts
runCompTrans $ withSubstitutions substs $ deriveUntrans origASTTypes (TH.ConT ''PythonTerm)
type instance Targ [l] = [Targ l]
instance Untrans ListF where
untrans :: ListF T i -> T i
untrans NilF = Targ i -> T i
forall i. Targ i -> T i
T []
untrans (ConsF a :: T l
a b :: T [l]
b) = Targ i -> T i
forall i. Targ i -> T i
T ((T l -> Targ l
forall i. T i -> Targ i
t T l
a) Targ l -> [Targ l] -> [Targ l]
forall a. a -> [a] -> [a]
: (T [l] -> Targ [l]
forall i. T i -> Targ i
t T [l]
b))
type instance Targ (Maybe l) = Maybe (Targ l)
instance Untrans MaybeF where
untrans :: MaybeF T i -> T i
untrans NothingF = Targ i -> T i
forall i. Targ i -> T i
T Targ i
forall a. Maybe a
Nothing
untrans (JustF x :: T l
x) = Targ i -> T i
forall i. Targ i -> T i
T (Targ l -> Maybe (Targ l)
forall a. a -> Maybe a
Just (T l -> Targ l
forall i. T i -> Targ i
t T l
x))
type instance Targ (l, l') = (Targ l, Targ l')
instance Untrans PairF where
untrans :: PairF T i -> T i
untrans (PairF x :: T i
x y :: T j
y) = Targ i -> T i
forall i. Targ i -> T i
T (T i -> Targ i
forall i. T i -> Targ i
t T i
x, T j -> Targ j
forall i. T i -> Targ i
t T j
y)
type instance Targ CharL = Char
instance Untrans CharF where
untrans :: CharF T i -> T i
untrans (CharF c :: Char
c) = Targ i -> T i
forall i. Targ i -> T i
T Char
Targ i
c
type instance Targ () = ()
instance Untrans UnitF where
untrans :: UnitF T i -> T i
untrans UnitF = Targ i -> T i
forall i. Targ i -> T i
T ()
instance (All Untrans fs) => Untrans (Sum fs) where
untrans :: Sum fs T i -> T i
untrans = Proxy Untrans
-> (forall (f :: (* -> *) -> * -> *). Untrans f => f T i -> T i)
-> Sum fs T i
-> T i
forall (cxt :: ((* -> *) -> * -> *) -> Constraint)
(fs :: [(* -> *) -> * -> *]) (a :: * -> *) e b.
All cxt fs =>
Proxy cxt
-> (forall (f :: (* -> *) -> * -> *). cxt f => f a e -> b)
-> Sum fs a e
-> b
caseCxt (Proxy Untrans
forall k (t :: k). Proxy t
Proxy @Untrans) forall (f :: (* -> *) -> * -> *). Untrans f => f T i -> T i
forall (f :: (* -> *) -> * -> *). Untrans f => Alg f T
untrans
#endif