module Language.Elna.AST
    ( ConstantDefinition(..)
    , Expression(..)
    , Identifier(..)
    , Literal(..)
    , ProcedureDeclaration(..)
    , Program(..)
    , Statement(..)
    , VariableDeclaration(..)
    , TypeName(..)
    ) where

import Data.Int (Int32)
import Data.List (intercalate)
import Data.Word (Word8)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Char (chr)

newtype Identifier = Identifier { unIdentifier :: Text }
    deriving Eq

instance Show Identifier
  where
    show (Identifier identifier) = Text.unpack identifier

data TypeName
    = NamedType Identifier
    | PointerType TypeName
    | ArrayType TypeName Int32
    | ProcedureType [Parameter]
    deriving Eq

instance Show TypeName
  where
    show (NamedType typeName) = show typeName
    show (PointerType typeName) = '^' : show typeName
    show (ArrayType typeName elementCount) = concat
        [show typeName, "[", show elementCount, "]"]
    show (ProcedureType parameters) = "proc" <> showParameters parameters

data Literal
    = StringLiteral Text
    | IntegerLiteral Int32
    | CharacterLiteral Word8
    | BooleanLiteral Bool
    deriving Eq

instance Show Literal
  where
    show (StringLiteral string) = Text.unpack
        $ "\"" <> string <> "\""
    show (IntegerLiteral integer) = show integer
    show (CharacterLiteral character) =
        '\'' : chr (fromEnum character) : ['\'']
    show (BooleanLiteral boolean)
        | boolean = "true"
        | otherwise = "false"

data Expression
    = VariableExpression Identifier
    | LiteralExpression Literal
    | NegationExpression Expression
    | NotExpression Expression
    | ReferenceExpression Expression
    | DereferenceExpression Expression
    | SumExpression Expression Expression
    | SubtractionExpression Expression Expression
    | ProductExpression Expression Expression
    | DivisionExpression Expression Expression
    | EqualExpression Expression Expression
    | NonEqualExpression Expression Expression
    | LessExpression Expression Expression
    | GreaterExpression Expression Expression
    | LessOrEqualExpression Expression Expression
    | GreaterOrEqualExpression Expression Expression
    | IfExpression Expression Statement Statement
    | LoopExpression Expression Statement
    | FieldExpression Expression Identifier
    deriving Eq

instance Show Expression
  where
    show (VariableExpression variable) = show variable
    show (LiteralExpression literal) = show literal
    show (NegationExpression negation) = '-' : show negation
    show (NotExpression negation) = "not " <> show negation
    show (ReferenceExpression reference) = '@' : show reference
    show (DereferenceExpression dereference) = show dereference <> "^"
    show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
    show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
    show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
    show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
    show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
    show (NonEqualExpression lhs rhs) = concat [show lhs, " /= ", show rhs]
    show (LessExpression lhs rhs) = concat [show lhs, " < ", show rhs]
    show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
    show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
    show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
    show (IfExpression condition if' else') = concat
        [ "if ", show condition
        , " then " <> show if'
        , " else " <> show else'
        ]
    show (LoopExpression accumulator iteration) = concat
        ["loop ", show accumulator, " do ", show iteration]
    show (FieldExpression fieldExpression identifier) =
        show fieldExpression <> "." <> show identifier

data Statement
    = LetStatement Identifier TypeName Expression
    | CompoundStatement [Statement]
    | CallStatement Identifier [Expression]
    | ExpressionStatement Expression
    | BreakStatement Expression
    | ContinueStatement Expression
    deriving Eq

instance Show Statement
  where
    show (LetStatement identifier typeName definition) = concat
        ["let ", show identifier, ": ", show typeName, " := ", show definition]
    show (CompoundStatement statements) = "begin "
        <> intercalate "; " (show <$> statements) <> " end"
    show (CallStatement name parameters) = show name <> "("
        <> intercalate ", " (show <$> parameters) <> ")"
    show (ExpressionStatement expression) = show expression
    show (BreakStatement break') = "break " <> show break'
    show (ContinueStatement continue') = "continue " <> show continue'

data ConstantDefinition =
    ConstantDefinition Identifier TypeName Literal
    deriving Eq

instance Show ConstantDefinition
  where
    show (ConstantDefinition identifier typeName definition) = concat
        [show identifier, ": ", show typeName, " := ", show definition, ";"]

data Parameter = Parameter Identifier TypeName
    deriving Eq

instance Show Parameter
  where
    show (Parameter identifier typeName) =
        show identifier <> ": " <> show typeName

data ProcedureDeclaration
    = ProcedureDeclaration Identifier [Parameter]
    | ProcedureDefinition Identifier [Parameter] Bool [ConstantDefinition] Statement
    deriving Eq

instance Show ProcedureDeclaration
  where
    show (ProcedureDeclaration procedureName parameters) =
        "proc " <> show procedureName <> showParameters parameters <> "; extern;"
    show (ProcedureDefinition procedureName parameters exports constants body)
        = "proc " <> show procedureName <> showParameters parameters <> ";"
        <> showAttributes exports
        <> showConstants constants
        <> show body <> ";"

data VariableDeclaration
    = VariableDeclaration Identifier TypeName
    | VariableDefinition Identifier TypeName (Maybe Literal) Bool
    deriving Eq

instance Show VariableDeclaration
  where
    show (VariableDeclaration identifier typeName)
        = show identifier <> ": " <> show typeName <> "; extern;"
    show (VariableDefinition identifier typeName initialValue exports)
        = show identifier <> ": " <> show typeName
        <> maybe "" ((" = " <>) . show) initialValue <> ";"
        <> showAttributes exports

data Program = Program [ConstantDefinition] [VariableDeclaration] [ProcedureDeclaration] Statement
    deriving Eq

instance Show Program
  where
    show (Program constants globals procedures body)
        = showConstants constants <> showVariables globals
        <> unlines (show <$> procedures) <> show body <> "."

showAttributes :: Bool -> String
showAttributes True = " export;"
showAttributes False = ""

showParameters :: [Parameter] -> String
showParameters parameters =
    "(" <> intercalate ", " (show <$> parameters) <> ")"

showConstants :: [ConstantDefinition] -> String
showConstants constants
    | null constants = ""
    | otherwise = " const " <> unwords (show <$> constants) <> "\n"

showVariables :: [VariableDeclaration] -> String
showVariables variables
    | null variables = ""
    | otherwise = " var " <> unwords (show <$> variables) <> "\n"