module Absyn.Base where

import Absyn.Type
import qualified Typing.Types as T

data BaseModule name w
  = Module
  { imports :: [Import]
  , stmts :: [w (BaseStmt name w)]
  }

data Import = Import
  { iGlobal :: Bool
  , iModule :: [String]
  , iAlias :: Maybe String
  , iItems :: Maybe [ImportItem]
  }

data ImportItem
  = ImportValue String
  | ImportType String [String]

data BaseStmt name w
  = Decl (w (BaseDecl name w))
  | Expr (w (BaseExpr name w))

newtype BaseCodeBlock name w = CodeBlock [w (BaseStmt name w)]

data BaseDecl name w
  = FnStmt (w (BaseFunction name w))
  | Enum String [String] [DataCtor]
  | Let (String, Maybe Type) (w (BaseExpr name w))
  | Class { className :: String
          , classVars :: [Param]
          , classMethods :: [w (BaseFunction name w)]
          }
  | Operator { opAssoc :: Associativity
             , opPrec :: Precedence
             , opGenerics :: Generics
             , opLhs :: Param
             , opName :: String
             , opRhs :: Param
             , opRetType :: Type
             , opBody :: w (BaseCodeBlock name w)
             }
  | Interface { intfName :: String
              , intfParam :: String
              , intfMethods :: [InterfaceItem]
              }
  | Implementation { implIntf :: name
                   , implGenerics :: Generics
                   , implType :: Type
                   , implMethods :: [w (BaseImplementationItem name w)]
                   }
  | TypeAlias { aliasName :: String
              , aliasVars :: [String]
              , aliasType :: Type
              , resolvedType :: Maybe T.Type
              }

data InterfaceItem
  = IntfVar (String, Type)
  | IntfOperator { intfOpAssoc :: Associativity
                 , intfOpPrec :: Precedence
                 , intfOpLhs :: Type
                 , intfOpName :: String
                 , intfOpRhs :: Type
                 , intfOpRetType :: Type
                 }

data BaseImplementationItem name w
  = ImplVar (String, w (BaseExpr name w))
  | ImplFunction { implName :: String
                 , implParams :: [String]
                 , implBody :: w (BaseCodeBlock name w)
                 }
  | ImplOperator { implOpLhs :: String
                 , implOpName :: String
                 , implOpRhs :: String
                 , implOpBody :: w (BaseCodeBlock name w)
                 }

data Associativity
  = AssocNone
  | AssocLeft
  | AssocRight

instance Show Associativity where
  show AssocNone = "none"
  show AssocLeft = "left"
  show AssocRight = "right"

data Precedence
  = PrecHigher String
  | PrecLower String
  | PrecEqual String
  | PrecValue Integer

type DataCtor = (String, Maybe [Type])
type Param = (String, Type)
type Generics = [(String, [String])]

data BaseFunction name w
  = Function
  { name :: String
  , generics :: Generics
  , params :: [Param]
  , retType :: Type
  , body :: w (BaseCodeBlock name w)
  }

data BaseExpr name w
  = Literal Literal
  | Ident [String]
  | ParenthesizedExpr (w (BaseExpr name w))
  | Match { expr :: w (BaseExpr name w)
          , cases :: [w (BaseCase name w)]
          }
  | If { ifCond :: w (BaseExpr name w)
       , ifBody :: w (BaseCodeBlock name w)
       , ifElseBody :: w (BaseCodeBlock name w)
       }
  | Call { callee :: w (BaseExpr name w)
         , constraintArgs :: [T.ConstraintArg]
         , typeArgs :: [Type]
         , args :: [w (BaseExpr name w)]
         }
  | BinOp { opConstraintArgs :: [T.ConstraintArg]
          , opTypeArgs :: [Type]
          , lhs :: w (BaseExpr name w)
          , op :: name
          , rhs :: w (BaseExpr name w)
          }
  | Record [(String, w (BaseExpr name w))]
  | List (Maybe T.Type) [w (BaseExpr name w)]
  | FieldAccess (w (BaseExpr name w)) String
  | FnExpr (w (BaseFunction name w))
  | Negate [T.ConstraintArg] (w (BaseExpr name w))

  -- Expressions that can only be generated by the compiler
  | VoidExpr
  | TypeCall (w (BaseExpr name w)) [T.ConstraintArg]

data BaseCase name w
  = Case
    { pattern :: w (BasePattern name w)
    , caseBody :: w (BaseCodeBlock name w)
    }

data BasePattern name w
  = PatDefault
  | PatLiteral Literal
  | PatVar String
  | PatRecord [(String, w (BasePattern name w))]
  | PatList [w (BasePattern name w)] PatternRest
  | PatCtor name [w (BasePattern name w)]

data PatternRest
  = NoRest
  | DiscardRest
  | NamedRest String

data Literal
  = Integer Integer
  | Float Double
  | Char Char
  | String String
  deriving (Eq)

instance Show Literal where
  show (Integer i) = show i
  show (Float i) = show i
  show (Char i) = show i
  show (String i) = show i
