{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
module Parse.Declaration where

import Control.Applicative ((<$>))
import Text.Parsec ((<|>), (<?>), choice, digit, optionMaybe, string, try)

import qualified AST.Declaration as D
import qualified Parse.Expression as Expr
import Parse.Helpers
import qualified Parse.Type as Type


declaration :: IParser D.SourceDecl
declaration =
    typeDecl <|> infixDecl <|> port <|> definition


definition :: IParser D.SourceDecl
definition = D.Definition <$> Expr.def


typeDecl :: IParser D.SourceDecl
typeDecl =
  do  try (reserved "type") <?> "type declaration"
      forcedWS
      isAlias <- optionMaybe (string "alias" >> forcedWS)

      name <- capVar
      args <- spacePrefix lowVar
      padded equals

      case isAlias of
        Just _ ->
            do  tipe <- Type.expr <?> "a type"
                return (D.TypeAlias name args tipe)

        Nothing ->
            do  tcs <- pipeSep1 Type.constructor <?> "a constructor for a union type"
                return $ D.Datatype name args tcs


infixDecl :: IParser D.SourceDecl
infixDecl = do
  assoc <-
      choice
        [ try (reserved "infixl") >> return D.L
        , try (reserved "infixr") >> return D.R
        , try (reserved "infix")  >> return D.N
        ]
  forcedWS
  n <- digit
  forcedWS
  D.Fixity assoc (read [n]) <$> anyOp


port :: IParser D.SourceDecl
port =
  do  try (reserved "port")
      whitespace
      name <- lowVar
      whitespace
      let port' op ctor expr =
            do  try op
                whitespace
                ctor name <$> expr

      D.Port <$>
          choice
            [ port' hasType D.PPAnnotation Type.expr
            , port' equals  D.PPDef Expr.expr
            ]