{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ViewPatterns          #-}

-- | The Haskell→Javascript compiler.

module Fay.Compiler
  (runCompileModule
  ,compileViaStr
  ,compileWith
  ,compileExp
  ,compileDecl
  ,compileToplevelModule
  ,compileModuleFromContents
  ,compileModuleFromAST
  ,parseFay)
  where

import           Fay.Compiler.Prelude

import           Fay.Compiler.Decl
import           Fay.Compiler.Defaults
import           Fay.Compiler.Desugar
import           Fay.Compiler.Exp
import           Fay.Compiler.FFI
import           Fay.Compiler.Import
import           Fay.Compiler.InitialPass        (initialPass)
import           Fay.Compiler.Misc
import           Fay.Compiler.Optimizer
import           Fay.Compiler.Parse
import           Fay.Compiler.PrimOp             (findPrimOp)
import           Fay.Compiler.QName
import           Fay.Compiler.State
import           Fay.Compiler.Typecheck
import           Fay.Config
import qualified Fay.Exts                        as F
import           Fay.Exts.NoAnnotation           (unAnn)
import qualified Fay.Exts.NoAnnotation           as N
import           Fay.Types

import           Control.Monad.Except            (throwError)
import           Control.Monad.RWS               (gets, modify)

import qualified Data.Set                        as S
import           Language.Haskell.Exts hiding (name)
import           Language.Haskell.Names          (annotateModule)

--------------------------------------------------------------------------------
-- Top level entry points

-- | Compile a Haskell source string to a JavaScript source string.
compileViaStr

  :: FilePath
  -> Config
  -> (F.Module -> Compile [JsStmt])
  -> String
  -> IO (Either CompileError (Printer,CompileState,CompileWriter))
compileViaStr :: FilePath
-> Config
-> (Module -> Compile [JsStmt])
-> FilePath
-> IO (Either CompileError (Printer, CompileState, CompileWriter))
compileViaStr FilePath
filepath Config
cfg Module -> Compile [JsStmt]
with FilePath
from = do
  CompileReader
rs <- Config -> IO CompileReader
defaultCompileReader Config
cfg
  CompileReader
-> CompileState
-> Compile Printer
-> IO (Either CompileError (Printer, CompileState, CompileWriter))
forall a.
CompileReader
-> CompileState
-> Compile a
-> IO (Either CompileError (a, CompileState, CompileWriter))
runTopCompile CompileReader
rs
             CompileState
defaultCompileState
             (((SrcLoc, FilePath) -> Compile Printer)
-> (Module -> Compile Printer)
-> ParseResult Module
-> Compile Printer
forall b a.
((SrcLoc, FilePath) -> b) -> (a -> b) -> ParseResult a -> b
parseResult (CompileError -> Compile Printer
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> Compile Printer)
-> ((SrcLoc, FilePath) -> CompileError)
-> (SrcLoc, FilePath)
-> Compile Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcLoc -> FilePath -> CompileError)
-> (SrcLoc, FilePath) -> CompileError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SrcLoc -> FilePath -> CompileError
ParseError)
                          (([JsStmt] -> Printer) -> Compile [JsStmt] -> Compile Printer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Printer] -> Printer
forall a. Monoid a => [a] -> a
mconcat ([Printer] -> Printer)
-> ([JsStmt] -> [Printer]) -> [JsStmt] -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JsStmt -> Printer) -> [JsStmt] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> Printer
forall a. Printable a => a -> Printer
printJS) (Compile [JsStmt] -> Compile Printer)
-> (Module -> Compile [JsStmt]) -> Module -> Compile Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Compile [JsStmt]
with)
                          (FilePath -> FilePath -> ParseResult Module
forall ast.
Parseable ast =>
FilePath -> FilePath -> ParseResult ast
parseFay FilePath
filepath FilePath
from))

-- | Compile the top-level Fay module.
compileToplevelModule :: FilePath -> F.Module -> Compile [JsStmt]
compileToplevelModule :: FilePath -> Module -> Compile [JsStmt]
compileToplevelModule FilePath
filein mod :: Module
mod@Module{}  = do
  Config
cfg <- (Config -> Config) -> Compile Config
forall a. (Config -> a) -> Compile a
config Config -> Config
forall a. a -> a
id
  Bool -> Compile () -> Compile ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configTypecheck Config
cfg) (Compile () -> Compile ()) -> Compile () -> Compile ()
forall a b. (a -> b) -> a -> b
$ do
    Either CompileError FilePath
res <- IO (Either CompileError FilePath)
-> Compile (Either CompileError FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Either CompileError FilePath)
 -> Compile (Either CompileError FilePath))
-> IO (Either CompileError FilePath)
-> Compile (Either CompileError FilePath)
forall a b. (a -> b) -> a -> b
$ Config -> FilePath -> IO (Either CompileError FilePath)
typecheck Config
cfg (FilePath -> IO (Either CompileError FilePath))
-> FilePath -> IO (Either CompileError FilePath)
forall a b. (a -> b) -> a -> b
$
             FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (ModuleName X -> FilePath
forall t. ModuleName t -> FilePath
F.moduleNameString (Module -> ModuleName X
forall a. SrcInfo a => Module a -> ModuleName a
F.moduleName Module
mod)) (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
               Config -> Maybe FilePath
configFilePath Config
cfg
    (CompileError -> Compile ())
-> (FilePath -> Compile ())
-> Either CompileError FilePath
-> Compile ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompileError -> Compile ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath -> Compile ()
warn Either CompileError FilePath
res
  FilePath -> Compile ()
initialPass FilePath
filein
  -- Reset imports after initialPass so the modules can be imported during code generation.
  ([JsStmt]
hstmts, [JsStmt]
fstmts) <- (FilePath -> FilePath -> Compile ([JsStmt], [JsStmt]))
-> FilePath -> Compile ([JsStmt], [JsStmt])
forall a.
(FilePath -> FilePath -> Compile a) -> FilePath -> Compile a
startCompile FilePath -> FilePath -> Compile ([JsStmt], [JsStmt])
compileFileWithSource FilePath
filein
  [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JsStmt]
hstmts[JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++[JsStmt]
fstmts)
compileToplevelModule FilePath
_ Module
m = CompileError -> Compile [JsStmt]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> Compile [JsStmt])
-> CompileError -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ FilePath -> Module -> CompileError
UnsupportedModuleSyntax FilePath
"compileToplevelModule" Module
m

--------------------------------------------------------------------------------
-- Compilers

-- | Compile a source string.
compileModuleFromContents :: String -> Compile ([JsStmt], [JsStmt])
compileModuleFromContents :: FilePath -> Compile ([JsStmt], [JsStmt])
compileModuleFromContents = FilePath -> FilePath -> Compile ([JsStmt], [JsStmt])
compileFileWithSource FilePath
"<interactive>"

-- | Compile given the location and source string.
compileFileWithSource :: FilePath -> String -> Compile ([JsStmt], [JsStmt])
compileFileWithSource :: FilePath -> FilePath -> Compile ([JsStmt], [JsStmt])
compileFileWithSource FilePath
filepath FilePath
contents = do
  Bool
exportStdlib <- (Config -> Bool) -> Compile Bool
forall a. (Config -> a) -> Compile a
config Config -> Bool
configExportStdlib
  (([JsStmt]
hstmts,[JsStmt]
fstmts),CompileState
st,CompileWriter
wr) <- FilePath
-> (([JsStmt], [JsStmt]) -> Module -> Compile ([JsStmt], [JsStmt]))
-> (FilePath -> FilePath -> Compile ([JsStmt], [JsStmt]))
-> (X -> Module -> IO (Either CompileError Module))
-> FilePath
-> Compile (([JsStmt], [JsStmt]), CompileState, CompileWriter)
forall a.
(Monoid a, Semigroup a) =>
FilePath
-> (a -> Module -> Compile a)
-> (FilePath -> FilePath -> Compile a)
-> (X -> Module -> IO (Either CompileError Module))
-> FilePath
-> Compile (a, CompileState, CompileWriter)
compileWith FilePath
filepath ([JsStmt], [JsStmt]) -> Module -> Compile ([JsStmt], [JsStmt])
compileModuleFromAST FilePath -> FilePath -> Compile ([JsStmt], [JsStmt])
compileFileWithSource X -> Module -> IO (Either CompileError Module)
forall l.
(Data l, Typeable l) =>
l -> Module l -> IO (Either CompileError (Module l))
desugar FilePath
contents
  (CompileState -> CompileState) -> Compile ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompileState -> CompileState) -> Compile ())
-> (CompileState -> CompileState) -> Compile ()
forall a b. (a -> b) -> a -> b
$ \CompileState
s -> CompileState
s { stateImported :: [(ModuleName, FilePath)]
stateImported      = CompileState -> [(ModuleName, FilePath)]
stateImported      CompileState
st
                   , stateJsModulePaths :: Set ModulePath
stateJsModulePaths = CompileState -> Set ModulePath
stateJsModulePaths CompileState
st
                   }
  [JsStmt]
hstmts' <- [JsStmt] -> Compile [JsStmt]
maybeOptimize ([JsStmt] -> Compile [JsStmt]) -> [JsStmt] -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ [JsStmt]
hstmts [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ CompileWriter -> [JsStmt]
writerCons CompileWriter
wr [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ Bool -> ModuleName -> CompileWriter -> [JsStmt]
forall a. Bool -> ModuleName a -> CompileWriter -> [JsStmt]
makeTranscoding Bool
exportStdlib (CompileState -> ModuleName
stateModuleName CompileState
st) CompileWriter
wr
  [JsStmt]
fstmts' <- [JsStmt] -> Compile [JsStmt]
maybeOptimize [JsStmt]
fstmts
  ([JsStmt], [JsStmt]) -> Compile ([JsStmt], [JsStmt])
forall (m :: * -> *) a. Monad m => a -> m a
return ([JsStmt]
hstmts', [JsStmt]
fstmts')
  where
    makeTranscoding :: Bool -> ModuleName a -> CompileWriter -> [JsStmt]
    makeTranscoding :: Bool -> ModuleName a -> CompileWriter -> [JsStmt]
makeTranscoding Bool
exportStdlib ModuleName a
moduleName CompileWriter{[(FilePath, JsExp)]
[JsStmt]
writerJsToFay :: CompileWriter -> [(FilePath, JsExp)]
writerFayToJs :: CompileWriter -> [(FilePath, JsExp)]
writerJsToFay :: [(FilePath, JsExp)]
writerFayToJs :: [(FilePath, JsExp)]
writerCons :: [JsStmt]
writerCons :: CompileWriter -> [JsStmt]
..} =
      let fay2js :: [JsStmt]
fay2js = if [(FilePath, JsExp)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, JsExp)]
writerFayToJs Bool -> Bool -> Bool
|| (ModuleName a -> Bool
forall a. ModuleName a -> Bool
anStdlibModule ModuleName a
moduleName Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
exportStdlib)
                     then []
                     else [(FilePath, JsExp)] -> [JsStmt]
fayToJsHash [(FilePath, JsExp)]
writerFayToJs
          js2fay :: [JsStmt]
js2fay = if [(FilePath, JsExp)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, JsExp)]
writerJsToFay Bool -> Bool -> Bool
|| (ModuleName a -> Bool
forall a. ModuleName a -> Bool
anStdlibModule ModuleName a
moduleName Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
exportStdlib)
                     then []
                     else [(FilePath, JsExp)] -> [JsStmt]
jsToFayHash [(FilePath, JsExp)]
writerJsToFay
      in [JsStmt]
fay2js [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
js2fay
    maybeOptimize :: [JsStmt] -> Compile [JsStmt]
    maybeOptimize :: [JsStmt] -> Compile [JsStmt]
maybeOptimize [JsStmt]
stmts = do
      Config
cfg <- (Config -> Config) -> Compile Config
forall a. (Config -> a) -> Compile a
config Config -> Config
forall a. a -> a
id
      [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JsStmt] -> Compile [JsStmt]) -> [JsStmt] -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ if Config -> Bool
configOptimize Config
cfg
        then ([JsStmt] -> Optimize [JsStmt]) -> [JsStmt] -> [JsStmt]
runOptimizer [JsStmt] -> Optimize [JsStmt]
optimizeToplevel [JsStmt]
stmts
        else [JsStmt]
stmts

-- | Compile a parse HSE module.
compileModuleFromAST :: ([JsStmt], [JsStmt]) -> F.Module -> Compile ([JsStmt], [JsStmt])
compileModuleFromAST :: ([JsStmt], [JsStmt]) -> Module -> Compile ([JsStmt], [JsStmt])
compileModuleFromAST ([JsStmt]
hstmts0, [JsStmt]
fstmts0) mod' :: Module
mod'@Module{} = do
  ~mod :: Module (Scoped X)
mod@(Module Scoped X
_ Maybe (ModuleHead (Scoped X))
_ [ModulePragma (Scoped X)]
pragmas [ImportDecl (Scoped X)]
_ [Decl (Scoped X)]
decls) <- Language -> [Extension] -> Module -> Compile (Module (Scoped X))
forall (m :: * -> *) l.
(MonadModule m, ModuleInfo m ~ Symbols, Data l, SrcInfo l, Eq l) =>
Language -> [Extension] -> Module l -> m (Module (Scoped l))
annotateModule Language
Haskell2010 [Extension]
defaultExtensions Module
mod'
  let modName :: ModuleName
modName = ModuleName (Scoped X) -> ModuleName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn (ModuleName (Scoped X) -> ModuleName)
-> ModuleName (Scoped X) -> ModuleName
forall a b. (a -> b) -> a -> b
$ Module (Scoped X) -> ModuleName (Scoped X)
forall a. SrcInfo a => Module a -> ModuleName a
F.moduleName Module (Scoped X)
mod
  (CompileState -> CompileState) -> Compile ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompileState -> CompileState) -> Compile ())
-> (CompileState -> CompileState) -> Compile ()
forall a b. (a -> b) -> a -> b
$ \CompileState
s -> CompileState
s { stateUseFromString :: Bool
stateUseFromString = [FilePath] -> [ModulePragma (Scoped X)] -> Bool
forall l. [FilePath] -> [ModulePragma l] -> Bool
hasLanguagePragmas [FilePath
"OverloadedStrings", FilePath
"RebindableSyntax"] [ModulePragma (Scoped X)]
pragmas
                   }
  [JsStmt]
current <- Bool -> [Decl (Scoped X)] -> Compile [JsStmt]
compileDecls Bool
True [Decl (Scoped X)]
decls

  Bool
exportStdlib     <- (Config -> Bool) -> Compile Bool
forall a. (Config -> a) -> Compile a
config Config -> Bool
configExportStdlib
  Bool
exportStdlibOnly <- (Config -> Bool) -> Compile Bool
forall a. (Config -> a) -> Compile a
config Config -> Bool
configExportStdlibOnly
  [JsStmt]
modulePaths      <- ModuleName -> Compile [JsStmt]
forall a. ModuleName a -> Compile [JsStmt]
createModulePath ModuleName
modName
  [JsStmt]
extExports       <- Compile [JsStmt]
generateExports
  [JsStmt]
strictExports    <- Compile [JsStmt]
generateStrictExports
  let hstmts :: [JsStmt]
hstmts = [JsStmt]
hstmts0 [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
modulePaths [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
current [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
extExports
      fstmts :: [JsStmt]
fstmts = [JsStmt]
fstmts0 [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
strictExports
  ([JsStmt], [JsStmt]) -> Compile ([JsStmt], [JsStmt])
forall (m :: * -> *) a. Monad m => a -> m a
return (([JsStmt], [JsStmt]) -> Compile ([JsStmt], [JsStmt]))
-> ([JsStmt], [JsStmt]) -> Compile ([JsStmt], [JsStmt])
forall a b. (a -> b) -> a -> b
$ if Bool
exportStdlibOnly
    then if ModuleName -> Bool
forall a. ModuleName a -> Bool
anStdlibModule ModuleName
modName
            then ([JsStmt]
hstmts, [JsStmt]
fstmts)
            else ([], [])
    else if Bool -> Bool
not Bool
exportStdlib Bool -> Bool -> Bool
&& ModuleName -> Bool
forall a. ModuleName a -> Bool
anStdlibModule ModuleName
modName
            then ([], [])
            else ([JsStmt]
hstmts, [JsStmt]
fstmts)
compileModuleFromAST ([JsStmt], [JsStmt])
_ Module
mod = CompileError -> Compile ([JsStmt], [JsStmt])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> Compile ([JsStmt], [JsStmt]))
-> CompileError -> Compile ([JsStmt], [JsStmt])
forall a b. (a -> b) -> a -> b
$ FilePath -> Module -> CompileError
UnsupportedModuleSyntax FilePath
"compileModuleFromAST" Module
mod


--------------------------------------------------------------------------------
-- Misc compilation

-- | For a module A.B, generate
-- | var A = {};
-- | A.B = {};
createModulePath :: ModuleName a -> Compile [JsStmt]
createModulePath :: ModuleName a -> Compile [JsStmt]
createModulePath (ModuleName a -> ModuleName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn -> ModuleName
m) = do
  Config
cfg <- (Config -> Config) -> Compile Config
forall a. (Config -> a) -> Compile a
config Config -> Config
forall a. a -> a
id
  let isTs :: Bool
isTs = Config -> Bool
configTypeScript Config
cfg
  [JsStmt]
reg <- ([[JsStmt]] -> [JsStmt]) -> Compile [[JsStmt]] -> Compile [JsStmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[JsStmt]] -> [JsStmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Compile [[JsStmt]] -> Compile [JsStmt])
-> (ModuleName -> Compile [[JsStmt]])
-> ModuleName
-> Compile [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePath -> Compile [JsStmt])
-> [ModulePath] -> Compile [[JsStmt]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> ModulePath -> Compile [JsStmt]
modPath Bool
isTs) ([ModulePath] -> Compile [[JsStmt]])
-> (ModuleName -> [ModulePath]) -> ModuleName -> Compile [[JsStmt]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [ModulePath]
forall a. ModuleName a -> [ModulePath]
mkModulePaths (ModuleName -> Compile [JsStmt]) -> ModuleName -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ ModuleName
m
  [JsStmt]
strict <-
    if ModuleName -> Config -> Bool
forall a. ModuleName a -> Config -> Bool
shouldExportStrictWrapper ModuleName
m Config
cfg
      then ([[JsStmt]] -> [JsStmt]) -> Compile [[JsStmt]] -> Compile [JsStmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[JsStmt]] -> [JsStmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Compile [[JsStmt]] -> Compile [JsStmt])
-> (ModuleName -> Compile [[JsStmt]])
-> ModuleName
-> Compile [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePath -> Compile [JsStmt])
-> [ModulePath] -> Compile [[JsStmt]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> ModulePath -> Compile [JsStmt]
modPath Bool
isTs) ([ModulePath] -> Compile [[JsStmt]])
-> (ModuleName -> [ModulePath]) -> ModuleName -> Compile [[JsStmt]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [ModulePath]
forall a. ModuleName a -> [ModulePath]
mkModulePaths (ModuleName -> Compile [JsStmt]) -> ModuleName -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ (\(ModuleName ()
i FilePath
n) -> () -> FilePath -> ModuleName
forall l. l -> FilePath -> ModuleName l
ModuleName ()
i (FilePath
"Strict." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n)) ModuleName
m
       else [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JsStmt] -> Compile [JsStmt]) -> [JsStmt] -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ [JsStmt]
reg [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
strict
  where
    modPath :: Bool -> ModulePath -> Compile [JsStmt]
    modPath :: Bool -> ModulePath -> Compile [JsStmt]
modPath Bool
isTs ModulePath
mp = ModulePath -> (ModulePath -> [JsStmt]) -> Compile [JsStmt]
whenImportNotGenerated ModulePath
mp ((ModulePath -> [JsStmt]) -> Compile [JsStmt])
-> (ModulePath -> [JsStmt]) -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ \(ModulePath -> [FilePath]
unModulePath -> [FilePath]
l) -> case [FilePath]
l of
     [FilePath
n] -> if Bool
isTs
              then [JsName -> JsExp -> JsStmt
JsMapVar (QName -> JsName
JsNameVar (QName -> JsName) -> (Name () -> QName) -> Name () -> JsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Name () -> QName
forall l. l -> Name l -> QName l
UnQual () (Name () -> JsName) -> Name () -> JsName
forall a b. (a -> b) -> a -> b
$ () -> FilePath -> Name ()
forall l. l -> FilePath -> Name l
Ident () FilePath
n) ([(FilePath, JsExp)] -> JsExp
JsObj [])]
              else [JsName -> JsExp -> JsStmt
JsVar (QName -> JsName
JsNameVar (QName -> JsName) -> (Name () -> QName) -> Name () -> JsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Name () -> QName
forall l. l -> Name l -> QName l
UnQual () (Name () -> JsName) -> Name () -> JsName
forall a b. (a -> b) -> a -> b
$ () -> FilePath -> Name ()
forall l. l -> FilePath -> Name l
Ident () FilePath
n) ([(FilePath, JsExp)] -> JsExp
JsObj [])]
     [FilePath]
_   -> [ModulePath -> JsExp -> JsStmt
JsSetModule ModulePath
mp ([(FilePath, JsExp)] -> JsExp
JsObj [])]

    whenImportNotGenerated :: ModulePath -> (ModulePath -> [JsStmt]) -> Compile [JsStmt]
    whenImportNotGenerated :: ModulePath -> (ModulePath -> [JsStmt]) -> Compile [JsStmt]
whenImportNotGenerated ModulePath
mp ModulePath -> [JsStmt]
makePath = do
      Bool
added <- (CompileState -> Bool) -> Compile Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((CompileState -> Bool) -> Compile Bool)
-> (CompileState -> Bool) -> Compile Bool
forall a b. (a -> b) -> a -> b
$ ModulePath -> CompileState -> Bool
addedModulePath ModulePath
mp
      if Bool
added
        then [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
          (CompileState -> CompileState) -> Compile ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompileState -> CompileState) -> Compile ())
-> (CompileState -> CompileState) -> Compile ()
forall a b. (a -> b) -> a -> b
$ ModulePath -> CompileState -> CompileState
addModulePath ModulePath
mp
          [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JsStmt] -> Compile [JsStmt]) -> [JsStmt] -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ ModulePath -> [JsStmt]
makePath ModulePath
mp

-- | Generate exports for non local names, local exports have already been added to the module.
generateExports :: Compile [JsStmt]
generateExports :: Compile [JsStmt]
generateExports = do
  ModuleName
modName <- (CompileState -> ModuleName) -> Compile ModuleName
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompileState -> ModuleName
stateModuleName
  [JsStmt]
-> (Set QName -> [JsStmt]) -> Maybe (Set QName) -> [JsStmt]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((QName -> JsStmt) -> [QName] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> QName -> JsStmt
exportExp ModuleName
modName) ([QName] -> [JsStmt])
-> (Set QName -> [QName]) -> Set QName -> [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set QName -> [QName]
forall a. Set a -> [a]
S.toList) (Maybe (Set QName) -> [JsStmt])
-> Compile (Maybe (Set QName)) -> Compile [JsStmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompileState -> Maybe (Set QName)) -> Compile (Maybe (Set QName))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ModuleName -> CompileState -> Maybe (Set QName)
getNonLocalExportsWithoutNewtypes ModuleName
modName)
  where
    exportExp :: N.ModuleName -> N.QName -> JsStmt
    exportExp :: ModuleName -> QName -> JsStmt
exportExp ModuleName
m QName
v = Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
forall a. Maybe a
Nothing (ModuleName -> QName -> QName
forall a. ModuleName a -> QName a -> QName a
changeModule ModuleName
m QName
v) (JsExp -> JsStmt) -> JsExp -> JsStmt
forall a b. (a -> b) -> a -> b
$ case QName -> Maybe QName
findPrimOp QName
v of
      Just QName
p  -> JsName -> JsExp
JsName (JsName -> JsExp) -> JsName -> JsExp
forall a b. (a -> b) -> a -> b
$ QName -> JsName
JsNameVar QName
p -- TODO add test case for this case, is it needed at all?
      Maybe QName
Nothing -> JsName -> JsExp
JsName (JsName -> JsExp) -> JsName -> JsExp
forall a b. (a -> b) -> a -> b
$ QName -> JsName
JsNameVar QName
v

-- | Generate strict wrappers for the exports of the module.
generateStrictExports :: Compile [JsStmt]
generateStrictExports :: Compile [JsStmt]
generateStrictExports = do
  Config
cfg <- (Config -> Config) -> Compile Config
forall a. (Config -> a) -> Compile a
config Config -> Config
forall a. a -> a
id
  ModuleName
modName <- (CompileState -> ModuleName) -> Compile ModuleName
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompileState -> ModuleName
stateModuleName
  if ModuleName -> Config -> Bool
forall a. ModuleName a -> Config -> Bool
shouldExportStrictWrapper ModuleName
modName Config
cfg
    then do
      Maybe (Set QName)
locals <- (CompileState -> Maybe (Set QName)) -> Compile (Maybe (Set QName))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ModuleName -> CompileState -> Maybe (Set QName)
getLocalExportsWithoutNewtypes ModuleName
modName)
      Maybe (Set QName)
nonLocals <- (CompileState -> Maybe (Set QName)) -> Compile (Maybe (Set QName))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ModuleName -> CompileState -> Maybe (Set QName)
getNonLocalExportsWithoutNewtypes ModuleName
modName)
      let int :: [JsStmt]
int = [JsStmt]
-> (Set QName -> [JsStmt]) -> Maybe (Set QName) -> [JsStmt]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((QName -> JsStmt) -> [QName] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map QName -> JsStmt
exportExp' ([QName] -> [JsStmt])
-> (Set QName -> [QName]) -> Set QName -> [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set QName -> [QName]
forall a. Set a -> [a]
S.toList) Maybe (Set QName)
locals
      let ext :: [JsStmt]
ext = [JsStmt]
-> (Set QName -> [JsStmt]) -> Maybe (Set QName) -> [JsStmt]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((QName -> JsStmt) -> [QName] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> QName -> JsStmt
exportExp ModuleName
modName)  ([QName] -> [JsStmt])
-> (Set QName -> [QName]) -> Set QName -> [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set QName -> [QName]
forall a. Set a -> [a]
S.toList) Maybe (Set QName)
nonLocals
      [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JsStmt] -> Compile [JsStmt]) -> [JsStmt] -> Compile [JsStmt]
forall a b. (a -> b) -> a -> b
$ [JsStmt]
int [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt]
ext
    else [JsStmt] -> Compile [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    exportExp :: N.ModuleName -> N.QName -> JsStmt
    exportExp :: ModuleName -> QName -> JsStmt
exportExp ModuleName
m QName
v = Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
forall a. Maybe a
Nothing ((FilePath -> FilePath) -> QName -> QName
forall a. (FilePath -> FilePath) -> QName a -> QName a
changeModule' (FilePath
"Strict." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (QName -> QName) -> QName -> QName
forall a b. (a -> b) -> a -> b
$ ModuleName -> QName -> QName
forall a. ModuleName a -> QName a -> QName a
changeModule ModuleName
m QName
v) (JsExp -> JsStmt) -> JsExp -> JsStmt
forall a b. (a -> b) -> a -> b
$ JsName -> JsExp
JsName (JsName -> JsExp) -> JsName -> JsExp
forall a b. (a -> b) -> a -> b
$ QName -> JsName
JsNameVar (QName -> JsName) -> QName -> JsName
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> QName -> QName
forall a. (FilePath -> FilePath) -> QName a -> QName a
changeModule' (FilePath
"Strict." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) QName
v

    exportExp' :: N.QName -> JsStmt
    exportExp' :: QName -> JsStmt
exportExp' QName
name = Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
forall a. Maybe a
Nothing ((FilePath -> FilePath) -> QName -> QName
forall a. (FilePath -> FilePath) -> QName a -> QName a
changeModule' (FilePath
"Strict." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) QName
name) (JsExp -> JsStmt) -> JsExp -> JsStmt
forall a b. (a -> b) -> a -> b
$ JsExp -> JsExp
serialize (JsName -> JsExp
JsName (QName -> JsName
JsNameVar QName
name))

    serialize :: JsExp -> JsExp
    serialize :: JsExp -> JsExp
serialize JsExp
n = JsExp -> [JsExp] -> JsExp
JsApp (FilePath -> JsExp
JsRawExp FilePath
"Fay$$fayToJs") [FilePath -> JsExp
JsRawExp FilePath
"['automatic']", JsExp
n]

-- | Is the module a standard module, i.e., one that we'd rather not
-- output code for if we're compiling separate files.
anStdlibModule :: ModuleName a -> Bool
anStdlibModule :: ModuleName a -> Bool
anStdlibModule (ModuleName a
_ FilePath
name) = FilePath
name FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"Prelude",FilePath
"FFI",FilePath
"Fay.FFI",FilePath
"Data.Data",FilePath
"Data.Ratio",FilePath
"Debug.Trace",FilePath
"Data.Char"]