{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP                     #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE GADTs                   #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE TemplateHaskell         #-}
{-# LANGUAGE TypeApplications        #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE TypeSynonymInstances    #-}
{-# LANGUAGE UndecidableInstances    #-}

#ifdef ONLY_ONE_LANGUAGE
module Cubix.Language.JavaScript.Parametric.Full.Trans () where
#else
module Cubix.Language.JavaScript.Parametric.Full.Trans (
    translate
  , untranslate
  ) where

import Data.Proxy
import Data.Typeable ( Typeable )

import qualified Language.Haskell.TH as TH
import qualified Language.JavaScript.Parser.AST as JS

import Data.Comp.Multi ( Sum, All, caseCxt )
import Data.Comp.Trans ( runCompTrans, deriveTrans, deriveUntrans )

import Cubix.Language.JavaScript.Parametric.Full.Names
import Cubix.Language.JavaScript.Parametric.Full.Types
import Cubix.Language.Parametric.Syntax.Functor

runCompTrans $ deriveTrans origASTTypes (TH.ConT ''JSTerm)

translate :: JS.JSAST -> JSTerm JSASTL
translate :: JSAST -> JSTerm JSASTL
translate = JSAST -> JSTerm JSASTL
forall a i. Trans a i => a -> JSTerm i
trans

instance (Trans c l) => Trans (JS.JSCommaList c) (JSCommaList l) where
  trans :: JSCommaList c -> JSTerm (JSCommaList l)
trans (JS.JSLCons a :: JSCommaList c
a b :: JSAnnot
b c :: c
c) = JSTerm (JSCommaList l)
-> JSTerm JSAnnotL
-> Cxt NoHole (Sum JSSig) (K ()) l
-> JSTerm (JSCommaList l)
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) l.
(JSCommaListF :<: f) =>
Cxt h f a (JSCommaList l)
-> Cxt h f a JSAnnotL -> Cxt h f a l -> Cxt h f a (JSCommaList l)
riJSLCons (JSCommaList c -> JSTerm (JSCommaList l)
forall a i. Trans a i => a -> JSTerm i
trans JSCommaList c
a) (JSAnnot -> JSTerm JSAnnotL
forall a i. Trans a i => a -> JSTerm i
trans JSAnnot
b) (c -> Cxt NoHole (Sum JSSig) (K ()) l
forall a i. Trans a i => a -> JSTerm i
trans c
c)
  trans (JS.JSLOne a :: c
a)      = Cxt NoHole (Sum JSSig) (K ()) l -> JSTerm (JSCommaList l)
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) l.
(JSCommaListF :<: f) =>
Cxt h f a l -> Cxt h f a (JSCommaList l)
riJSLOne (c -> Cxt NoHole (Sum JSSig) (K ()) l
forall a i. Trans a i => a -> JSTerm i
trans c
a)
  trans  JS.JSLNil         = JSTerm (JSCommaList l)
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) l.
(JSCommaListF :<: f) =>
Cxt h f a (JSCommaList l)
riJSLNil

instance (Trans c l, Trans (JS.JSCommaList c) (JSCommaList l))
            => Trans (JS.JSCommaTrailingList c) (JSCommaTrailingList l) where
  trans :: JSCommaTrailingList c -> JSTerm (JSCommaTrailingList l)
trans (JS.JSCTLComma a :: JSCommaList c
a b :: JSAnnot
b) = Cxt NoHole (Sum JSSig) (K ()) (JSCommaList l)
-> JSTerm JSAnnotL -> JSTerm (JSCommaTrailingList l)
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) l.
(JSCommaTrailingListF :<: f) =>
Cxt h f a (JSCommaList l)
-> Cxt h f a JSAnnotL -> Cxt h f a (JSCommaTrailingList l)
riJSCTLComma (JSCommaList c -> Cxt NoHole (Sum JSSig) (K ()) (JSCommaList l)
forall a i. Trans a i => a -> JSTerm i
trans JSCommaList c
a) (JSAnnot -> JSTerm JSAnnotL
forall a i. Trans a i => a -> JSTerm i
trans JSAnnot
b)
  trans (JS.JSCTLNone a :: JSCommaList c
a)    = Cxt NoHole (Sum JSSig) (K ()) (JSCommaList l)
-> JSTerm (JSCommaTrailingList l)
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) l.
(JSCommaTrailingListF :<: f) =>
Cxt h f a (JSCommaList l) -> Cxt h f a (JSCommaTrailingList l)
riJSCTLNone (JSCommaList c -> Cxt NoHole (Sum JSSig) (K ()) (JSCommaList l)
forall a i. Trans a i => a -> JSTerm i
trans JSCommaList c
a)

instance (Trans c l, Typeable l) => Trans [c] [l] where
  trans :: [c] -> JSTerm [l]
trans [] = JSTerm [l]
forall h (f :: (* -> *) -> * -> *) (a :: * -> *) l.
(ListF :<: f, Typeable l) =>
Cxt h f a [l]
riNilF
  trans (x :: c
x:xs :: [c]
xs) = (c -> JSTerm l
forall a i. Trans a i => a -> JSTerm i
trans c
x :: JSTerm l) JSTerm l -> JSTerm [l] -> JSTerm [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] -> JSTerm [l]
forall a i. Trans a i => a -> JSTerm i
trans [c]
xs)

instance (Trans c l, Typeable l) => Trans (Maybe c) (Maybe l) where
  trans :: Maybe c -> JSTerm (Maybe l)
trans Nothing  = JSTerm (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 JSSig (K ()) l -> JSTerm (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 JSSig (K ()) l -> JSTerm (Maybe l))
-> CxtS NoHole JSSig (K ()) l -> JSTerm (Maybe l)
forall a b. (a -> b) -> a -> b
$ (c -> CxtS NoHole JSSig (K ()) l
forall a i. Trans a i => a -> JSTerm i
trans c
x :: JSTerm l)


runCompTrans $ deriveUntrans origASTTypes (TH.ConT ''JSTerm)

type instance Targ (JSCommaList l) = JS.JSCommaList (Targ l)
instance Untrans JSCommaListF where
  untrans :: JSCommaListF T i -> T i
untrans (JSLCons a :: T (JSCommaList l)
a b :: T JSAnnotL
b c :: T l
c) = Targ i -> T i
forall i. Targ i -> T i
T (Targ i -> T i) -> Targ i -> T i
forall a b. (a -> b) -> a -> b
$ JSCommaList (Targ l) -> JSAnnot -> Targ l -> JSCommaList (Targ l)
forall a. JSCommaList a -> JSAnnot -> a -> JSCommaList a
JS.JSLCons (T (JSCommaList l) -> Targ (JSCommaList l)
forall i. T i -> Targ i
t T (JSCommaList l)
a) (T JSAnnotL -> Targ JSAnnotL
forall i. T i -> Targ i
t T JSAnnotL
b) (T l -> Targ l
forall i. T i -> Targ i
t T l
c)
  untrans (JSLOne a :: T l
a)      = Targ i -> T i
forall i. Targ i -> T i
T (Targ i -> T i) -> Targ i -> T i
forall a b. (a -> b) -> a -> b
$ Targ l -> JSCommaList (Targ l)
forall a. a -> JSCommaList a
JS.JSLOne (T l -> Targ l
forall i. T i -> Targ i
t T l
a)
  untrans  JSLNil         = Targ i -> T i
forall i. Targ i -> T i
T (Targ i -> T i) -> Targ i -> T i
forall a b. (a -> b) -> a -> b
$ Targ i
forall a. JSCommaList a
JS.JSLNil

type instance Targ (JSCommaTrailingList l) = JS.JSCommaTrailingList (Targ l)
instance Untrans JSCommaTrailingListF where
  untrans :: JSCommaTrailingListF T i -> T i
untrans (JSCTLComma a :: T (JSCommaList l)
a b :: T JSAnnotL
b) = Targ i -> T i
forall i. Targ i -> T i
T (Targ i -> T i) -> Targ i -> T i
forall a b. (a -> b) -> a -> b
$ JSCommaList (Targ l) -> JSAnnot -> JSCommaTrailingList (Targ l)
forall a. JSCommaList a -> JSAnnot -> JSCommaTrailingList a
JS.JSCTLComma (T (JSCommaList l) -> Targ (JSCommaList l)
forall i. T i -> Targ i
t T (JSCommaList l)
a) (T JSAnnotL -> Targ JSAnnotL
forall i. T i -> Targ i
t T JSAnnotL
b)
  untrans (JSCTLNone a :: T (JSCommaList l)
a)    = Targ i -> T i
forall i. Targ i -> T i
T (Targ i -> T i) -> Targ i -> T i
forall a b. (a -> b) -> a -> b
$ JSCommaList (Targ l) -> JSCommaTrailingList (Targ l)
forall a. JSCommaList a -> JSCommaTrailingList a
JS.JSCTLNone (T (JSCommaList l) -> Targ (JSCommaList l)
forall i. T i -> Targ i
t T (JSCommaList l)
a)

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))

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