{-# OPTIONS_HADDOCK hide #-}

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

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

#ifdef ONLY_ONE_LANGUAGE
module Cubix.Language.Python.Parametric.Full.Names () where
#else
module Cubix.Language.Python.Parametric.Full.Names (
    origASTTypes
  , newASTTypes
  , pythonSigNames
  , makeSubsts

    -- * Annotation-handling
  , isAnn
  , propAnn
  , annType
  , annotatedSourceType
  ) where

import           Data.Map ( Map )
import qualified Data.Map as Map

import           Language.Haskell.TH hiding ( Name )
import qualified Language.Haskell.TH as TH
import           Language.Python.Common.AST

import           Data.Comp.Trans ( runCompTrans, generateNameLists, getTypeParamVars, defaultPropAnn )

import           Cubix.Language.Info
import           Cubix.Language.Parametric.Syntax.Base
import           Cubix.Language.Parametric.Syntax.Functor

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

runCompTrans $ generateNameLists ''Module

pythonSigNames :: [TH.Name]
pythonSigNames :: [Name]
pythonSigNames = [Name]
newASTTypes [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [''PairF, ''ListF, ''MaybeF, ''UnitF, ''CharF]

makeSubsts :: Q (Map TH.Name Type)
makeSubsts :: Q (Map Name Type)
makeSubsts = do
  [Name]
vars <- CompTrans [Name] -> Q [Name]
forall a. CompTrans a -> Q a
runCompTrans (CompTrans [Name] -> Q [Name]) -> CompTrans [Name] -> Q [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> CompTrans [Name]
getTypeParamVars [Name]
origASTTypes
  let substs :: Map Name Type
substs = [(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Name] -> [Type] -> [(Name, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
vars (Type -> [Type]
forall a. a -> [a]
repeat (Type -> [Type]) -> Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
AppT (Name -> Type
ConT ''Maybe) (Name -> Type
ConT ''SourceSpan)))
  Map Name Type -> Q (Map Name Type)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
return Map Name Type
substs


----------------------------------
-------- Annotation handling
----------------------------------

isAnn :: TH.Type -> Bool
isAnn :: Type -> Bool
isAnn = (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== (Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT ''Maybe) (Name -> Type
TH.ConT ''SourceSpan)))

propAnn :: [(TH.Exp, TH.Type)] -> TH.Exp
propAnn :: [(Exp, Type)] -> Exp
propAnn = Exp -> [(Exp, Type)] -> Exp
defaultPropAnn (Name -> Exp
TH.ConE 'Nothing)

annType :: TH.Type
annType :: Type
annType = (Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT ''Maybe) (Name -> Type
TH.ConT ''SourceSpan))

annotatedSourceType :: TH.Type
annotatedSourceType :: Type
annotatedSourceType = Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT ''Module) Type
annType

#endif