{-# OPTIONS_GHC -W #-}
module Build.Source (build) where

import qualified Data.Map as Map
import System.FilePath as FP
import Text.PrettyPrint (Doc)

import AST.Declaration
import AST.Module
import qualified AST.Expression.General as Expr
import qualified AST.Pattern as Pattern
import qualified AST.Type as Type
import qualified Parse.Parse as Parse
import qualified Metadata.Prelude as Prelude
import qualified Transform.Check as Check
import qualified Transform.SortDefinitions as SD
import qualified Type.Inference as TI
import qualified Transform.Declaration as TcDecl
import qualified Transform.Canonicalize as Canonical

build :: Bool -> Interfaces -> String -> Either [Doc] MetadataModule
build noPrelude interfaces source =
  do let add = Prelude.add noPrelude
         infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
                 . concatMap iFixities $ Map.elems interfaces

     Module names exs ims decls <- do
           modul@(Module _ _ _ decls) <- add `fmap` Parse.program infixes source
           case Check.mistakes decls of
             [] -> return modul
             ms -> Left ms

     let exports'
             | null exs =
                 let get = Pattern.boundVarList in
                 concat [ get pattern | Definition (Expr.Definition pattern _ _) <- decls ] ++
                 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
                 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
             | otherwise = exs

     metaModule <- Canonical.metadataModule interfaces $
         MetadataModule
         { names = names
         , path = FP.joinPath names
         , exports = exports'
         , imports = ims
           -- reorder AST into strongly connected components
         , program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls
         , types = Map.empty
         , datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ]
         , fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
         , aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ]
         , ports = [ portName port | Port port <- decls ]
         }

     types <- TI.infer interfaces metaModule

     return $ metaModule { types = types }