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

import Data.Int (Int32)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
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 TypeDefinition
    = RecordDefinition Identifier (NonEmpty Parameter)
    | VariantDefinition Identifier (NonEmpty Parameter)
    deriving Eq

instance Show TypeDefinition
  where
    show (RecordDefinition identifier fields) = show identifier
        <> " = record " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
        <> " end;"
    show (VariantDefinition identifier fields) = show identifier
        <> " = variant " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
        <> " end;"

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

instance Show Program
  where
    show (Program types constants globals procedures body)
        = unlines (show <$> types)
        <> 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"