module Fay.Compiler
(runCompile
,compileViaStr
,compileToAst
,compileModule
,compileExp
,compileDecl
,compileToplevelModule
,parseFay)
where
import Fay.Compiler.Config
import Fay.Compiler.Decl
import Fay.Compiler.Defaults
import Fay.Compiler.Exp
import Fay.Compiler.FFI
import Fay.Compiler.InitialPass (initialPass)
import Fay.Compiler.Misc
import Fay.Compiler.Optimizer
import Fay.Compiler.Typecheck
import Fay.Types
import Control.Applicative
import Control.Monad.Error
import Control.Monad.IO
import Control.Monad.State
import Control.Monad.RWS
import Data.Default (def)
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S
import Language.Haskell.Exts
compileViaStr :: (Show from,Show to,CompilesTo from to)
=> FilePath
-> CompileConfig
-> (from -> Compile to)
-> String
-> IO (Either CompileError (PrintState,CompileState,CompileWriter))
compileViaStr filepath config with from = do
cs <- defaultCompileState
rs <- defaultCompileReader config
runCompile rs
cs
(parseResult (throwError . uncurry ParseError)
(fmap (\x -> execState (runPrinter (printJS x)) printConfig) . with)
(parseFay filepath from))
where printConfig = def { psPretty = configPrettyPrint config }
compileToAst :: (Show from,Show to,CompilesTo from to)
=> FilePath
-> CompileReader
-> CompileState
-> (from -> Compile to)
-> String
-> IO (Either CompileError (to,CompileState,CompileWriter))
compileToAst filepath reader state with from =
runCompile reader
state
(parseResult (throwError . uncurry ParseError)
with
(parseFay filepath from))
compileToplevelModule :: Module -> Compile [JsStmt]
compileToplevelModule mod@(Module _ (ModuleName modulename) _ _ _ _ _) = do
cfg <- config id
when (configTypecheck cfg) $
typecheck (configPackageConf cfg) (configWall cfg) $
fromMaybe modulename $ configFilePath cfg
initialPass mod
cs <- io defaultCompileState
modify $ \s -> s { stateImported = stateImported cs }
(stmts,CompileWriter{..}) <- listen $ compileModule True mod
let fay2js = if null writerFayToJs then [] else fayToJsDispatcher writerFayToJs
js2fay = if null writerJsToFay then [] else jsToFayDispatcher writerJsToFay
maybeOptimize = if configOptimize cfg then runOptimizer optimizeToplevel else id
if configDispatcherOnly cfg
then return (maybeOptimize (writerCons ++ fay2js ++ js2fay))
else return (maybeOptimize (stmts ++
if configDispatchers cfg then writerCons ++ fay2js ++ js2fay else []))
compileModule :: Bool -> Module -> Compile [JsStmt]
compileModule toplevel (Module _ modulename _pragmas Nothing _exports imports decls) =
withModuleScope $ do
imported <- fmap concat (mapM compileImport imports)
modify $ \s -> s { stateModuleName = modulename
, stateModuleScope = fromMaybe (error $ "Could not find stateModuleScope for " ++ show modulename) $ M.lookup modulename $ stateModuleScopes s
}
current <- compileDecls True decls
exportStdlib <- config configExportStdlib
exportStdlibOnly <- config configExportStdlibOnly
if exportStdlibOnly
then if anStdlibModule modulename || toplevel
then if toplevel
then return imported
else return (current ++ imported)
else return []
else if not exportStdlib && anStdlibModule modulename
then return []
else return (imported ++ current)
compileModule _ mod = throwError (UnsupportedModuleSyntax mod)
instance CompilesTo Module [JsStmt] where compileTo = compileModule False
anStdlibModule :: ModuleName -> Bool
anStdlibModule (ModuleName name) = elem name ["Prelude","FFI","Language.Fay.FFI","Data.Data"]
compileImport :: ImportDecl -> Compile [JsStmt]
compileImport (ImportDecl _ _ _ _ Just{} _ _) = return []
compileImport (ImportDecl _ name False _ Nothing Nothing _) =
unlessImported name $ \filepath contents -> do
state <- get
reader <- ask
result <- liftIO $ compileToAst filepath reader state (compileModule False) contents
case result of
Right (stmts,state,writer) -> do
tell writer
modify $ \s -> s { stateImported = stateImported state
, stateLocalScope = S.empty
}
return stmts
Left err -> throwError err
compileImport i = throwError $ UnsupportedImport i
unlessImported :: ModuleName
-> (FilePath -> String -> Compile [JsStmt])
-> Compile [JsStmt]
unlessImported "Fay.Types" _ = return []
unlessImported name importIt = do
imported <- gets stateImported
case lookup name imported of
Just _ -> return []
Nothing -> do
dirs <- configDirectoryIncludePaths <$> config id
(filepath,contents) <- findImport dirs name
modify $ \s -> s { stateImported = (name,filepath) : imported }
res <- importIt filepath contents
return res