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)

  | 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

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

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

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 }