{-# 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