{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
module Parse.Module
  ( fromByteString
  , ProjectType(..)
  , isKernel
  , chompImports
  , chompImport
  )
  where


import qualified Data.ByteString as BS
import qualified Data.Name as Name

import qualified AST.Source as Src
import qualified Elm.Compiler.Imports as Imports
import qualified Elm.Package as Pkg
import qualified Parse.Declaration as Decl
import qualified Parse.Keyword as Keyword
import qualified Parse.Space as Space
import qualified Parse.Symbol as Symbol
import qualified Parse.Variable as Var
import qualified Parse.Primitives as P
import Parse.Primitives hiding (State, fromByteString)
import qualified Reporting.Annotation as A
import qualified Reporting.Error.Syntax as E



-- FROM BYTE STRING


fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module
fromByteString projectType source =
  case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of
    Right modul -> checkModule projectType modul
    Left err    -> Left (E.ParseError err)



-- PROJECT TYPE


data ProjectType
  = Package Pkg.Name
  | Application


isCore :: ProjectType -> Bool
isCore projectType =
  case projectType of
    Package pkg -> pkg == Pkg.core
    Application -> False


isKernel :: ProjectType -> Bool
isKernel projectType =
  case projectType of
    Package pkg -> Pkg.isKernel pkg
    Application -> False



-- MODULE


data Module =
  Module
    { _header :: Maybe Header
    , _imports :: [Src.Import]
    , _infixes :: [A.Located Src.Infix]
    , _decls :: [Decl.Decl]
    }


chompModule :: ProjectType -> Parser E.Module Module
chompModule projectType =
  do  header <- chompHeader
      imports <- chompImports (if isCore projectType then [] else Imports.defaults)
      infixes <- if isKernel projectType then chompInfixes [] else return []
      decls <- specialize E.Declarations $ chompDecls []
      return (Module header imports infixes decls)



-- CHECK MODULE


checkModule :: ProjectType -> Module -> Either E.Error Src.Module
checkModule projectType (Module maybeHeader imports infixes decls) =
  let
    (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
  in
  case maybeHeader of
    Just (Header name effects exports docs) ->
      Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
        <$> checkEffects projectType ports effects

    Nothing ->
      Right $
        Src.Module Nothing (A.At A.one Src.Open) (Src.NoDocs A.one) imports values unions aliases infixes $
          case ports of
            [] -> Src.NoEffects
            _:_ -> Src.Ports ports


checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects
checkEffects projectType ports effects =
  case effects of
    NoEffects region ->
      case ports of
        [] ->
          Right Src.NoEffects

        Src.Port name _ : _ ->
          case projectType of
            Package _   -> Left (E.NoPortsInPackage name)
            Application -> Left (E.UnexpectedPort region)

    Ports region ->
      case projectType of
        Package _ ->
          Left (E.NoPortModulesInPackage region)

        Application ->
          case ports of
            []  -> Left (E.NoPorts region)
            _:_ -> Right (Src.Ports ports)

    Manager region manager ->
      if isKernel projectType then
        case ports of
          []  -> Right (Src.Manager region manager)
          _:_ -> Left (E.UnexpectedPort region)
      else
        Left (E.NoEffectsOutsideKernel region)



categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
categorizeDecls values unions aliases ports decls =
  case decls of
    [] ->
      (values, unions, aliases, ports)

    decl:otherDecls ->
      case decl of
        Decl.Value _ value -> categorizeDecls (value:values) unions aliases ports otherDecls
        Decl.Union _ union -> categorizeDecls values (union:unions) aliases ports otherDecls
        Decl.Alias _ alias -> categorizeDecls values unions (alias:aliases) ports otherDecls
        Decl.Port  _ port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls



-- TO DOCS


toDocs :: Either A.Region Src.Comment -> [Decl.Decl] -> Src.Docs
toDocs comment decls =
  case comment of
    Right overview ->
      Src.YesDocs overview (getComments decls [])

    Left region ->
      Src.NoDocs region


getComments :: [Decl.Decl] -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
getComments decls comments =
  case decls of
    [] ->
      comments

    decl:otherDecls ->
      case decl of
        Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getComments otherDecls (addComment c n comments)
        Decl.Union c (A.At _ (Src.Union n _ _  )) -> getComments otherDecls (addComment c n comments)
        Decl.Alias c (A.At _ (Src.Alias n _ _  )) -> getComments otherDecls (addComment c n comments)
        Decl.Port  c         (Src.Port  n _    )  -> getComments otherDecls (addComment c n comments)


addComment :: Maybe Src.Comment -> A.Located Name.Name -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
addComment maybeComment (A.At _ name) comments =
  case maybeComment of
    Just comment -> (name, comment) : comments
    Nothing      -> comments



-- FRESH LINES


freshLine :: (Row -> Col -> E.Module) -> Parser E.Module ()
freshLine toFreshLineError =
  do  Space.chomp E.ModuleSpace
      Space.checkFreshLine toFreshLineError



-- CHOMP DECLARATIONS


chompDecls :: [Decl.Decl] -> Parser E.Decl [Decl.Decl]
chompDecls decls =
  do  (decl, _) <- Decl.declaration
      oneOfWithFallback
        [ do  Space.checkFreshLine E.DeclStart
              chompDecls (decl:decls)
        ]
        (reverse (decl:decls))


chompInfixes :: [A.Located Src.Infix] -> Parser E.Module [A.Located Src.Infix]
chompInfixes infixes =
  oneOfWithFallback
    [ do  binop <- Decl.infix_
          chompInfixes (binop:infixes)
    ]
    infixes



-- MODULE DOC COMMENT


chompModuleDocCommentSpace :: Parser E.Module (Either A.Region Src.Comment)
chompModuleDocCommentSpace =
  do  (A.At region ()) <- addLocation (freshLine E.FreshLine)
      oneOfWithFallback
        [
          do  docComment <- Space.docComment E.ImportStart E.ModuleSpace
              Space.chomp E.ModuleSpace
              Space.checkFreshLine E.FreshLine
              return (Right docComment)
        ]
        (Left region)



-- HEADER


data Header =
  Header (A.Located Name.Name) Effects (A.Located Src.Exposing) (Either A.Region Src.Comment)


data Effects
  = NoEffects A.Region
  | Ports A.Region
  | Manager A.Region Src.Manager


chompHeader :: Parser E.Module (Maybe Header)
chompHeader =
  do  freshLine E.FreshLine
      start <- getPosition
      oneOfWithFallback
        [
          -- module MyThing exposing (..)
          do  Keyword.module_ E.ModuleProblem
              effectEnd <- getPosition
              Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
              name <- addLocation (Var.moduleName E.ModuleName)
              Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
              Keyword.exposing_ E.ModuleProblem
              Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
              exports <- addLocation (specialize E.ModuleExposing exposing)
              comment <- chompModuleDocCommentSpace
              return $ Just $
                Header name (NoEffects (A.Region start effectEnd)) exports comment
        ,
          -- port module MyThing exposing (..)
          do  Keyword.port_ E.PortModuleProblem
              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
              Keyword.module_ E.PortModuleProblem
              effectEnd <- getPosition
              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
              name <- addLocation (Var.moduleName E.PortModuleName)
              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
              Keyword.exposing_ E.PortModuleProblem
              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
              exports <- addLocation (specialize E.PortModuleExposing exposing)
              comment <- chompModuleDocCommentSpace
              return $ Just $
                Header name (Ports (A.Region start effectEnd)) exports comment
        ,
          -- effect module MyThing where { command = MyCmd } exposing (..)
          do  Keyword.effect_ E.Effect
              Space.chompAndCheckIndent E.ModuleSpace E.Effect
              Keyword.module_ E.Effect
              effectEnd <- getPosition
              Space.chompAndCheckIndent E.ModuleSpace E.Effect
              name <- addLocation (Var.moduleName E.ModuleName)
              Space.chompAndCheckIndent E.ModuleSpace E.Effect
              Keyword.where_ E.Effect
              Space.chompAndCheckIndent E.ModuleSpace E.Effect
              manager <- chompManager
              Space.chompAndCheckIndent E.ModuleSpace E.Effect
              Keyword.exposing_ E.Effect
              Space.chompAndCheckIndent E.ModuleSpace E.Effect
              exports <- addLocation (specialize (const E.Effect) exposing)
              comment <- chompModuleDocCommentSpace
              return $ Just $
                Header name (Manager (A.Region start effectEnd) manager) exports comment
        ]
        -- default header
        Nothing


chompManager :: Parser E.Module Src.Manager
chompManager =
  do  word1 0x7B {- { -} E.Effect
      spaces_em
      oneOf E.Effect
        [ do  cmd <- chompCommand
              spaces_em
              oneOf E.Effect
                [ do  word1 0x7D {-}-} E.Effect
                      spaces_em
                      return (Src.Cmd cmd)
                , do  word1 0x2C {-,-} E.Effect
                      spaces_em
                      sub <- chompSubscription
                      spaces_em
                      word1 0x7D {-}-} E.Effect
                      spaces_em
                      return (Src.Fx cmd sub)
                ]
        , do  sub <- chompSubscription
              spaces_em
              oneOf E.Effect
                [ do  word1 0x7D {-}-} E.Effect
                      spaces_em
                      return (Src.Sub sub)
                , do  word1 0x2C {-,-} E.Effect
                      spaces_em
                      cmd <- chompCommand
                      spaces_em
                      word1 0x7D {-}-} E.Effect
                      spaces_em
                      return (Src.Fx cmd sub)
                ]
        ]


chompCommand :: Parser E.Module (A.Located Name.Name)
chompCommand =
  do  Keyword.command_ E.Effect
      spaces_em
      word1 0x3D {-=-} E.Effect
      spaces_em
      addLocation (Var.upper E.Effect)


chompSubscription :: Parser E.Module (A.Located Name.Name)
chompSubscription =
  do  Keyword.subscription_ E.Effect
      spaces_em
      word1 0x3D {-=-} E.Effect
      spaces_em
      addLocation (Var.upper E.Effect)


spaces_em :: Parser E.Module ()
spaces_em =
  Space.chompAndCheckIndent E.ModuleSpace E.Effect



-- IMPORTS


chompImports :: [Src.Import] -> Parser E.Module [Src.Import]
chompImports is =
  oneOfWithFallback
    [ do  i <- chompImport
          chompImports (i:is)
    ]
    (reverse is)


chompImport :: Parser E.Module Src.Import
chompImport =
  do  Keyword.import_ E.ImportStart
      Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName
      name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)
      Space.chomp E.ModuleSpace
      oneOf E.ImportEnd
        [ do  Space.checkFreshLine E.ImportEnd
              return $ Src.Import name Nothing (Src.Explicit [])
        , do  Space.checkIndent end E.ImportEnd
              oneOf E.ImportAs
                [ chompAs name
                , chompExposing name Nothing
                ]
        ]


chompAs :: A.Located Name.Name -> Parser E.Module Src.Import
chompAs name =
  do  Keyword.as_ E.ImportAs
      Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias
      alias <- Var.upper E.ImportAlias
      end <- getPosition
      Space.chomp E.ModuleSpace
      oneOf E.ImportEnd
        [ do  Space.checkFreshLine E.ImportEnd
              return $ Src.Import name (Just alias) (Src.Explicit [])
        , do  Space.checkIndent end E.ImportEnd
              chompExposing name (Just alias)
        ]


chompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import
chompExposing name maybeAlias =
  do  Keyword.exposing_ E.ImportExposing
      Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList
      exposed <- specialize E.ImportExposingList exposing
      freshLine E.ImportEnd
      return $ Src.Import name maybeAlias exposed



-- LISTING


exposing :: Parser E.Exposing Src.Exposing
exposing =
  do  word1 0x28 {-(-} E.ExposingStart
      Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
      oneOf E.ExposingValue
        [ do  word2 0x2E 0x2E {-..-} E.ExposingValue
              Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
              word1 0x29 {-)-} E.ExposingEnd
              return Src.Open
        , do  exposed <- chompExposed
              Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
              exposingHelp [exposed]
        ]


exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing
exposingHelp revExposed =
  oneOf E.ExposingEnd
    [ do  word1 0x2C {-,-} E.ExposingEnd
          Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
          exposed <- chompExposed
          Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
          exposingHelp (exposed:revExposed)
    , do  word1 0x29 {-)-} E.ExposingEnd
          return (Src.Explicit (reverse revExposed))
    ]


chompExposed :: Parser E.Exposing Src.Exposed
chompExposed =
  do  start <- getPosition
      oneOf E.ExposingValue
        [ do  name <- Var.lower E.ExposingValue
              end <- getPosition
              return $ Src.Lower $ A.at start end name
        , do  word1 0x28 {-(-} E.ExposingValue
              op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
              word1 0x29 {-)-} E.ExposingOperatorRightParen
              end <- getPosition
              return $ Src.Operator (A.Region start end) op
        , do  name <- Var.upper E.ExposingValue
              end <- getPosition
              Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
              Src.Upper (A.at start end name) <$> privacy
        ]


privacy :: Parser E.Exposing Src.Privacy
privacy =
  oneOfWithFallback
    [ do  word1 0x28 {-(-} E.ExposingTypePrivacy
          Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
          start <- getPosition
          word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
          end <- getPosition
          Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
          word1 0x29 {-)-} E.ExposingTypePrivacy
          return $ Src.Public (A.Region start end)
    ]
    Src.Private