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

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

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

module Cubix.Language.Solidity.Modularized.Trans (
    translate
  , untranslate
  ) where

import Data.Text ( Text )
import Data.Typeable ( Typeable )

import qualified Language.Haskell.TH as TH
import qualified Solidity as S

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

import Cubix.Language.Parametric.Syntax
  ( IntF (..), IntL, ListF (..), MaybeF (..), PairF (..), TextF (..), TextL, TripleF (..), UnitF (..)
  , iConsF, iIntF, iJustF, iTextF, iUnitF, riNilF, riNothingF, riPairF, riTripleF )
import Cubix.Language.Solidity.Modularized.Names
import Cubix.Language.Solidity.Modularized.Types

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


--------------------------------------------------------------------------------------
-------------------- Trans (third-party syntax to modularized syntax) ----------------
--------------------------------------------------------------------------------------

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

translate :: S.Solidity -> SolidityTerm SolidityL
translate :: Solidity -> SolidityTerm SolidityL
translate = Solidity -> SolidityTerm SolidityL
forall a i. Trans a i => a -> SolidityTerm i
trans

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

instance (Trans c l, Typeable l) => Trans (Maybe c) (Maybe l) where
  trans :: Maybe c -> SolidityTerm (Maybe l)
trans Maybe c
Nothing = SolidityTerm (Maybe l)
forall h (f :: Fragment) (a :: * -> *) l.
(MaybeF :<: f, Typeable l) =>
Cxt h f a (Maybe l)
riNothingF
  trans (Just c
x) = CxtS NoHole SoliditySig (K ()) l -> SolidityTerm (Maybe l)
forall (fs :: [Fragment]) 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 SoliditySig (K ()) l -> SolidityTerm (Maybe l))
-> CxtS NoHole SoliditySig (K ()) l -> SolidityTerm (Maybe l)
forall a b. (a -> b) -> a -> b
$ (c -> CxtS NoHole SoliditySig (K ()) l
forall a i. Trans a i => a -> SolidityTerm i
trans c
x :: SolidityTerm l)

instance (Trans c l, Trans d l', Typeable l, Typeable l') => Trans (c, d) (l, l') where
  trans :: (c, d) -> SolidityTerm (l, l')
trans (c
x, d
y) = Cxt NoHole (Sum SoliditySig) (K ()) l
-> Cxt NoHole (Sum SoliditySig) (K ()) l' -> SolidityTerm (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 SoliditySig) (K ()) l
forall a i. Trans a i => a -> SolidityTerm i
trans c
x) (d -> Cxt NoHole (Sum SoliditySig) (K ()) l'
forall a i. Trans a i => a -> SolidityTerm i
trans d
y)


instance (Trans c l, Trans d l', Trans e l'',
          Typeable l, Typeable l', Typeable l'') => Trans (c, d, e) (l, l', l'') where
  trans :: (c, d, e) -> SolidityTerm (l, l', l'')
trans (c
x, d
y, e
z) = Cxt NoHole (Sum SoliditySig) (K ()) l
-> Cxt NoHole (Sum SoliditySig) (K ()) l'
-> Cxt NoHole (Sum SoliditySig) (K ()) l''
-> SolidityTerm (l, l', l'')
forall (f :: Fragment) i j k h (a :: * -> *).
(TripleF :<: f, Typeable i, Typeable j, Typeable k) =>
Cxt h f a i -> Cxt h f a j -> Cxt h f a k -> Cxt h f a (i, j, k)
riTripleF (c -> Cxt NoHole (Sum SoliditySig) (K ()) l
forall a i. Trans a i => a -> SolidityTerm i
trans c
x) (d -> Cxt NoHole (Sum SoliditySig) (K ()) l'
forall a i. Trans a i => a -> SolidityTerm i
trans d
y) (e -> Cxt NoHole (Sum SoliditySig) (K ()) l''
forall a i. Trans a i => a -> SolidityTerm i
trans e
z)


instance Trans Int IntL where
  trans :: Int -> SolidityTerm IntL
trans = Int -> SolidityTerm IntL
forall h (fs :: [Fragment]) (a :: * -> *) j.
(IntF :-<: fs, InjF fs IntL j) =>
Int -> CxtS h fs a j
iIntF

instance Trans Text TextL where
  trans :: Text -> SolidityTerm TextL
trans = Text -> SolidityTerm TextL
forall h (fs :: [Fragment]) (a :: * -> *) j.
(TextF :-<: fs, InjF fs TextL j) =>
Text -> CxtS h fs a j
iTextF

instance Trans () () where
  trans :: () -> SolidityTerm ()
trans ()
_ = SolidityTerm ()
forall h (fs :: [Fragment]) (a :: * -> *) j.
(UnitF :-<: fs, InjF fs () j) =>
CxtS h fs a j
iUnitF


--------------------------------------------------------------------------------------
-------------------- Untrans (modularized syntax to third-party syntax) --------------
--------------------------------------------------------------------------------------

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

type instance Targ [l] = [Targ l]
instance Untrans ListF where
  untrans :: Alg ListF T
untrans ListF T i
NilF = Targ i -> T i
forall i. Targ i -> T i
T []
  untrans (ConsF T l1
a T [l1]
b) = 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 where
  untrans :: Alg MaybeF T
untrans MaybeF T i
NothingF = 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) = 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 where
  untrans :: Alg PairF T
untrans (PairF T i
x 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 (l, l', l'') = (Targ l, Targ l', Targ l'')
instance Untrans TripleF where
  untrans :: Alg TripleF T
untrans (TripleF T i
x T j
y T k
z) = 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, T k -> Targ k
forall i. T i -> Targ i
t T k
z)


type instance Targ IntL = Int
instance Untrans IntF where
  untrans :: Alg IntF T
untrans (IntF Int
x) = Targ i -> T i
forall i. Targ i -> T i
T Int
Targ i
x

type instance Targ TextL = Text
instance Untrans TextF where
  untrans :: Alg TextF T
untrans (TextF Text
x) = Targ i -> T i
forall i. Targ i -> T i
T Text
Targ i
x

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

instance (All Untrans fs) => Untrans (Sum fs) where
  untrans :: Alg (Sum fs) T
untrans = forall (cxt :: Fragment -> Constraint) (fs :: [Fragment])
       (a :: * -> *) e b.
All cxt fs =>
(forall (f :: Fragment). cxt f => f a e -> b) -> Sum fs a e -> b
caseCxt @Untrans f T i -> T i
Alg f T
forall (f :: Fragment). Untrans f => f T i -> T i
forall (f :: Fragment). Untrans f => Alg f T
untrans