{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Ubc.Parse.Syntax.Struct
( Struct(..)
, parse
)
where

-- yay, explicit dependency on ghc
import GHC.Generics (Generic, Generically(..))

import Control.Monad ((<$!>))

import Text.Parsec
    ( choice,
      many,
      try,
      ParsecT,
      )

import Ubc.Parse.Syntax.VariableType (VariableType)

import Ubc.Parse.Syntax.Function (Function)

import qualified Ubc.Parse.Syntax.Language as UbcLanguage
import qualified Ubc.Parse.Syntax.VariableType as VariableType
import qualified Ubc.Parse.Syntax.Function as Function
import qualified Ubc.Parse.Syntax.Generic as Syntax.Generic
import Ubc.Parse.Syntax (Token)

type VariableName = Token

data Struct = Struct
        { name :: Token
        , generics :: [Syntax.Generic.Generic]
        , body :: StructBody
        }
        deriving (Show)

data StructBody = StructBody
        { variables :: [(VariableName, VariableType)]
        , functions :: [Function]
        }
        deriving stock (Generic, Show)
        deriving (Semigroup, Monoid) via Generically StructBody

parse :: Monad m => ParsecT Token u m Struct
parse = do
        _ <- UbcLanguage.reserved "struct"
        structIdentifier <- UbcLanguage.identifier
        structGenerics   <- UbcLanguage.angles $ UbcLanguage.commaSeparated1 Syntax.Generic.parse
        structBody       <- mconcat <$!> UbcLanguage.braces (many structMember)

        pure $ Struct structIdentifier structGenerics structBody

structMember :: Monad m => ParsecT Token u m StructBody
structMember = choice [ structVariableOrFunction ]

structVariableOrFunction :: Monad m => ParsecT Token u m StructBody
structVariableOrFunction = do
        (typeName, identifier) <- try $ do
                typeName <- UbcLanguage.typeName
                objectIdentifier <- UbcLanguage.identifier
                return (VariableType.fromString typeName, objectIdentifier)
        choice
                [ parseVariable typeName identifier
                , (\ f -> mempty { functions = [f] }) <$!> Function.parsePrefixed typeName identifier
                ]

parseVariable :: Monad m => VariableType -> Token -> ParsecT Token u m StructBody
parseVariable variableType variableName = do
        _ <- UbcLanguage.semicolon
        return $ mempty { variables = [(variableName, variableType)] }