module Frontend.Syntax where

import Frontend.Parser.Posn
import qualified Data.Text as T
import Data.Text (Text)

data FeExpr var
  = Ref var
  | Con var
  | App (FeExpr var) (FeExpr var)
  | Lam (FePat var) (FeExpr var)
  | Let [FeDecl var] (FeExpr var)
  | Tuple [FeExpr var]
  | Annot (FeExpr var) (FeType var)
  | Infix (FeExpr var) var (FeExpr var)

  | Literal Literal

  | ParenExp (FeExpr var)
  | SPExpr (FeExpr var) Posn Posn
  deriving (Eq, Show, Ord)

instance HasPosn (FeExpr var) where
  startPosn (SPExpr _ s _) = s
  startPosn _              = error "no start posn in parsed expression?"

  endPosn (SPExpr _ _ e) = e
  endPosn _              = error "no end posn in parsed expression?"

  span sp ep (SPExpr x _ _) = SPExpr x (startPosn sp) (endPosn ep)
  span sp ep x              = SPExpr x (startPosn sp) (endPosn ep)

data FePat var
  = Var var
  | Wildcard

  | TupPat [FePat var]
  | LitPat Literal
  | ConPat var [FePat var]
  | InfixPat (FePat var) var (FePat var)

  | ParenPat (FePat var) -- parsed parentheses
  | SPPat (FePat var) Posn Posn
  deriving (Eq, Show, Ord)

instance HasPosn (FePat var) where
  startPosn (SPPat _ s _) = s
  startPosn _             = error "no start posn in parsed expression?"

  endPosn (SPPat _ _ e) = e
  endPosn _             = error "no end posn in parsed pattern?"

  span sp ep (SPPat x _ _) = SPPat x (startPosn sp) (endPosn ep)
  span sp ep x             = SPPat x (startPosn sp) (endPosn ep)

data FeType var
  = Tyvar var
  | Tycon var
  | Tyapp (FeType var) (FeType var)
  | Tyarr (FeType var) (FeType var)
  | Tytup [FeType var]
  | Tylist (FeType var)

  | ParenType (FeType var) -- parsed parentheses
  | SPType (FeType var) Posn Posn
  deriving (Eq, Show, Ord)

instance HasPosn (FeType var) where
  startPosn (SPType _ s _) = s
  startPosn _             = error "no start posn in parsed type?"

  endPosn (SPType _ _ e) = e
  endPosn _             = error "no end posn in parsed type?"

  span sp ep (SPType x _ _) = SPType x (startPosn sp) (endPosn ep)
  span sp ep x              = SPType x (startPosn sp) (endPosn ep)

data FeDecl var
  = PatDecl { pdPat :: FePat var, declRhs :: FeRhs var, declBegin :: Posn, declEnd :: Posn }
  | FunDecl { fdVar :: var, fdArgs :: [FePat var], declRhs :: FeRhs var, declBegin :: Posn, declEnd :: Posn }
  | TySig   { tsVars :: [var], tsType :: FeType var, declBegin :: Posn, declEnd :: Posn }
  deriving (Eq, Show, Ord)

instance HasPosn (FeDecl var) where
  startPosn = declBegin
  endPosn   = declEnd

  span sp ep s = s { declBegin = startPosn sp, declEnd = endPosn ep }

data FeRhs var
  = BareRhs { bareRhs :: FeExpr var, rhsWhere :: [FeDecl var], rhsBegin :: Posn, rhsEnd :: Posn }
  deriving (Eq, Show, Ord)

instance HasPosn (FeRhs var) where
  startPosn = rhsBegin
  endPosn   = rhsEnd

  span sp ep s = s { rhsBegin = startPosn sp, rhsEnd = endPosn ep }

data Literal
  = LitString T.Text
  | LitNumber Integer
  deriving (Eq, Show, Ord)

data FeModule var
  = Module { moduleName    :: var
           , moduleExports :: Maybe [NamespacedItem var]
           , moduleImports :: [ModuleImport var]
           , moduleItems   :: [ModuleItem var]
           }
  deriving (Eq, Show, Ord)

data ModuleImport var
  = Import { importMod       :: var
           , importList      :: Maybe [NamespacedItem var]
           , importQualified :: Bool
           , importAlias     :: Maybe var
           , importBegin     :: Posn
           , importEnd       :: Posn
           }
  deriving (Eq, Show, Ord)

instance HasPosn (ModuleImport var) where
  startPosn = importBegin
  endPosn   = importEnd

  span sp ep s = s { importBegin = startPosn sp, importEnd = endPosn ep }

data NamespacedItem var
  = IEVar    var
  | IECon    var
  | IEModule var
  deriving (Eq, Show, Ord)

data ModuleItem var
  = ModDecl   { itemDecl :: FeDecl var, itemBegin :: Posn, itemEnd :: Posn }
  | ModImport { itemImport :: ModuleImport var, itemBegin :: Posn, itemEnd :: Posn }
  | ModFfi    { itemForeign :: FfiItem var, itemBegin :: Posn, itemEnd :: Posn }
  deriving (Eq, Show, Ord)

data FfiItem var
  = FfiImport
    { fiVarName   :: var
    , fiType      :: FeType var
    , fiCallConv  :: FfiCallConv
    , fiSafety    :: Maybe FfiSafety
    , fiItem      :: Maybe FfiImpEnt
    , fiBegin     :: Posn
    , fiEnd       :: Posn
    }
  | FfiExport
    { fiVarName   :: var
    , fiType      :: FeType var
    , fiCallConv  :: FfiCallConv
    , fiExpCid    :: Maybe Text
    , fiBegin     :: Posn
    , fiEnd       :: Posn
    }
  deriving (Eq, Show, Ord)

data FfiCallConv = CC_CCall deriving (Eq, Show, Ord)
data FfiSafety   = Safe | Unsafe deriving (Eq, Show, Ord)
data FfiImpEnt
  = ForeignItem
    { fiItemName :: Maybe Text
    , fiHeader   :: Maybe Text
    , fiStatic   :: Bool
    , fiIsRef    :: Bool
    }
  | Dynamic
  | Wrapper
  deriving (Eq, Show, Ord)

data ParsedVar
  = UnqualVar
    { varId :: Text
    , varBegin :: Posn
    , varEnd :: Posn
    }
  | QualVar
    { varId     :: Text
    , varPrefix :: Text
    , varBegin  :: Posn
    , varEnd    :: Posn
    }
  | ModId
    { varId    :: Text
    , varBegin :: Posn
    , varEnd   :: Posn
    }
  | BuiltinId
    { varId       :: Text
    , varBuiltin  :: BuiltinIdClass
    , varBegin    :: Posn
    , varEnd      :: Posn
    }
  deriving (Eq, Show, Ord)

data BuiltinIdClass
  = BuiltinTuple !Int
  | BuiltinNil
  | BuiltinArrow
  deriving (Eq, Show, Ord)

toModId :: ParsedVar -> ParsedVar
toModId x@ModId{}             = x
toModId (UnqualVar x y z)     = ModId x y z
toModId (QualVar id pref b e) = ModId (pref <> T.singleton '.' <> id) b e
toModId BuiltinId{} =
  error "Built-in variable can not be a module identifier!"

instance HasPosn ParsedVar where
  startPosn = varBegin
  endPosn = varEnd

  span sp ep s = s { varBegin = startPosn sp, varEnd = endPosn ep }

instance HasPosn (ModuleItem var) where
  startPosn = itemBegin
  endPosn   = itemEnd

  span sp ep s = s { itemBegin = startPosn sp, itemEnd = endPosn ep }

instance HasPosn (FfiItem var) where
  startPosn = fiBegin
  endPosn   = fiEnd

  span sp ep s = s { fiBegin = startPosn sp, fiEnd = endPosn ep }