{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-} module Compile ( Artifacts(..) , compile ) where import qualified Data.Map as Map import qualified Data.Name as Name import qualified AST.Source as Src import qualified AST.Canonical as Can import qualified AST.Optimized as Opt import qualified Canonicalize.Module as Canonicalize import qualified Elm.Interface as I import qualified Elm.ModuleName as ModuleName import qualified Elm.Package as Pkg import qualified Nitpick.PatternMatches as PatternMatches import qualified Optimize.Module as Optimize import qualified Reporting.Error as E import qualified Reporting.Result as R import qualified Type.Constrain.Module as Type import qualified Type.Solve as Type import System.IO.Unsafe (unsafePerformIO) -- COMPILE data Artifacts = Artifacts { _modul :: Can.Module , _types :: Map.Map Name.Name Can.Annotation , _graph :: Opt.LocalGraph } compile :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts compile pkg ifaces modul = do canonical <- canonicalize pkg ifaces modul annotations <- typeCheck canonical () <- nitpick canonical objects <- optimize annotations canonical return (Artifacts canonical annotations objects) -- PHASES canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Can.Module canonicalize pkg ifaces modul = snd $ R.run E.BadNames $ Canonicalize.canonicalize pkg ifaces modul typeCheck :: Can.Module -> Either E.Error (Map.Map Name.Name Can.Annotation) typeCheck canonical = case unsafePerformIO (Type.run =<< Type.constrain canonical) of Right annotations -> Right annotations Left errors -> Left (E.BadTypes errors) nitpick :: Can.Module -> Either E.Error () nitpick canonical = case PatternMatches.check canonical of Right () -> Right () Left errors -> Left (E.BadPatterns errors) optimize :: Map.Map Name.Name Can.Annotation -> Can.Module -> Either E.Error Opt.LocalGraph optimize annotations canonical = snd $ R.run E.BadMains $ Optimize.optimize annotations canonical