{-# OPTIONS_HADDOCK hide #-}
--{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

{-# LANGUAGE CPP                    #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# LANGUAGE UndecidableInstances   #-}

-- This is a separate file due to GHC's phase restriction.

#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.Typeable (Typeable )

import Data.Comp.Multi ( caseCxt'', Sum, All, (:&:)(..), DistAnn )


import qualified Language.Python.Common.AST as P

import Data.Comp.Trans ( runCompTrans, withSubstitutions, deriveTrans, deriveUntrans, withAnnotationProp, defaultPropAnn, defaultUnpropAnn )

import Cubix.Language.Info
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

-----------------------------------------------------------------------------------

------------------------------------------------------------------------------------
-------------- Forward translation: 3rd-party syntax to modularized  ---------------
------------------------------------------------------------------------------------

do substs <- makeSubsts
   runCompTrans $ withAnnotationProp annType isAnn propAnn defaultUnpropAnn
                $ withSubstitutions substs
                $ deriveTrans origASTTypes annotatedTargType

translate :: P.Module (Maybe SourceSpan) -> PythonTermOptAnn SourceSpan ModuleL
translate :: Module (Maybe SourceSpan)
-> AnnTerm (Maybe SourceSpan) PythonSig ModuleL
translate = Module (Maybe SourceSpan)
-> AnnTerm (Maybe SourceSpan) PythonSig ModuleL
forall a i.
Trans a i =>
a -> AnnTerm (Maybe SourceSpan) PythonSig i
trans

instance (Trans c l, Typeable l) => Trans [c] [l] where
  trans :: [c] -> AnnTerm (Maybe SourceSpan) PythonSig [l]
trans [] = AnnTerm (Maybe SourceSpan) PythonSig [l]
forall h (f :: Fragment) (a :: * -> *) l.
(ListF :<: f, Typeable l) =>
Cxt h f a [l]
riNilF
  trans (c
x:[c]
xs) = c -> AnnTerm (Maybe SourceSpan) PythonSig l
forall a i.
Trans a i =>
a -> AnnTerm (Maybe SourceSpan) PythonSig i
trans c
x AnnTerm (Maybe SourceSpan) PythonSig l
-> AnnTerm (Maybe SourceSpan) PythonSig [l]
-> AnnTerm (Maybe SourceSpan) PythonSig [l]
forall (f :: Fragment) l h (a :: * -> *).
(ListF :<: f, Typeable l) =>
Cxt h f a l -> Cxt h f a [l] -> Cxt h f a [l]
`jConsF` [c] -> AnnTerm (Maybe SourceSpan) PythonSig [l]
forall a i.
Trans a i =>
a -> AnnTerm (Maybe SourceSpan) PythonSig i
trans [c]
xs

instance (Trans c l, Typeable l) => Trans (Maybe c) (Maybe l) where
  trans :: Maybe c -> AnnTerm (Maybe SourceSpan) PythonSig (Maybe l)
trans Maybe c
Nothing  = AnnTerm (Maybe SourceSpan) PythonSig (Maybe l)
forall h (f :: Fragment) (a :: * -> *) l.
(MaybeF :<: f, Typeable l) =>
Cxt h f a (Maybe l)
riNothingF
  trans (Just c
x) = Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l
-> AnnTerm (Maybe SourceSpan) PythonSig (Maybe l)
forall (f :: Fragment) l h (a :: * -> *).
(MaybeF :<: f, Typeable l) =>
Cxt h f a l -> Cxt h f a (Maybe l)
jJustF (Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l
 -> AnnTerm (Maybe SourceSpan) PythonSig (Maybe l))
-> Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l
-> AnnTerm (Maybe SourceSpan) PythonSig (Maybe l)
forall a b. (a -> b) -> a -> b
$ c -> Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l
forall a i.
Trans a i =>
a -> AnnTerm (Maybe SourceSpan) PythonSig i
trans c
x

instance (Trans c l, Trans d l', Typeable l, Typeable l') => Trans (c, d) (l, l')  where
  trans :: (c, d) -> AnnTerm (Maybe SourceSpan) PythonSig (l, l')
trans (c
x, d
y) = Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l
-> Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l'
-> AnnTerm (Maybe SourceSpan) PythonSig (l, l')
forall (f :: Fragment) 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 :&: Maybe SourceSpan) (K ()) l
forall a i.
Trans a i =>
a -> AnnTerm (Maybe SourceSpan) PythonSig i
trans c
x) (d -> Cxt NoHole (Sum PythonSig :&: Maybe SourceSpan) (K ()) l'
forall a i.
Trans a i =>
a -> AnnTerm (Maybe SourceSpan) PythonSig i
trans d
y)

instance Trans Char CharL where
  trans :: Char -> AnnTerm (Maybe SourceSpan) PythonSig CharL
trans Char
c = Char -> AnnTerm (Maybe SourceSpan) PythonSig CharL
forall {f :: Fragment} {h} {a :: * -> *}.
(CharF :<: f) =>
Char -> Cxt h f a CharL
jCharF Char
c

instance Trans () () where
  trans :: () -> AnnTerm (Maybe SourceSpan) PythonSig ()
trans ()
_ = AnnTerm (Maybe SourceSpan) PythonSig ()
forall h (f :: Fragment) (a :: * -> *).
(UnitF :<: f) =>
Cxt h f a ()
jUnitF



------------------------------------------------------------------------------------
------------ Backward translation: Modularized syntax to 3rd-party  ----------------
------------------------------------------------------------------------------------


do substs <- makeSubsts
   runCompTrans $ withAnnotationProp annType isAnn propAnn defaultUnpropAnn
                $ withSubstitutions substs
                $ deriveUntrans origASTTypes annotatedTargType


type instance Targ [l] = [Targ l]
instance Untrans (ListF :&: a) where
  untrans :: Alg (ListF :&: a) T
untrans (ListF T i
NilF :&: a
_) = Targ i -> T i
forall i. Targ i -> T i
T []
  untrans (ConsF T l1
a T [l1]
b :&: a
_) = Targ i -> T i
forall i. Targ i -> T i
T ((T l1 -> Targ l1
forall i. T i -> Targ i
t T l1
a) Targ l1 -> [Targ l1] -> [Targ l1]
forall a. a -> [a] -> [a]
: (T [l1] -> Targ [l1]
forall i. T i -> Targ i
t T [l1]
b))

type instance Targ (Maybe l) = Maybe (Targ l)
instance Untrans (MaybeF :&: a) where
  untrans :: Alg (MaybeF :&: a) T
untrans (MaybeF T i
NothingF :&: a
_) = Targ i -> T i
forall i. Targ i -> T i
T Maybe (Targ l1)
Targ i
forall a. Maybe a
Nothing
  untrans (JustF T l1
x :&: a
_) = Targ i -> T i
forall i. Targ i -> T i
T (Targ l1 -> Maybe (Targ l1)
forall a. a -> Maybe a
Just (T l1 -> Targ l1
forall i. T i -> Targ i
t T l1
x))

type instance Targ (l, l') = (Targ l, Targ l')
instance Untrans (PairF :&: a) where
  untrans :: Alg (PairF :&: a) T
untrans (PairF T i
x T j
y :&: a
_) = 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 :&: a) where
  untrans :: Alg (CharF :&: a) T
untrans (CharF Char
c :&: a
_) = Targ i -> T i
forall i. Targ i -> T i
T Char
Targ i
c

type instance Targ () = ()
instance Untrans (UnitF :&: a) where
  untrans :: Alg (UnitF :&: a) T
untrans (UnitF T i
UnitF :&: a
_) = Targ i -> T i
forall i. Targ i -> T i
T ()

instance (All Untrans (DistAnn fs a)) => Untrans (Sum fs :&: a) where
  untrans :: Alg (Sum fs :&: a) T
untrans = forall (cxt :: Fragment -> Constraint) (fs :: [Fragment]) a
       (e :: * -> *) l t.
All cxt (DistAnn fs a) =>
(forall (f :: Fragment). cxt (f :&: a) => (:&:) f a e l -> t)
-> (:&:) (Sum fs) a e l -> t
caseCxt'' @Untrans (:&:) f a T i -> T i
Alg (f :&: a) T
forall (f :: Fragment). Untrans f => Alg f T
forall (f :: Fragment). Untrans (f :&: a) => (:&:) f a T i -> T i
untrans
#endif