{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE ViewPatterns          #-}

-- | Main library entry point.

module Fay
  (module Fay.Config
  ,CompileError (..)
  ,CompileState (..)
  ,CompileResult (..)
  ,compileFile
  ,compileFileWithState
  ,compileFileWithResult
  ,compileFromTo
  ,compileFromToAndGenerateHtml
  ,toJsName
  ,toTsName
  ,showCompileError
  ,readConfigRuntime
  ) where

import           Fay.Compiler.Prelude

import           Fay.Compiler
import           Fay.Compiler.Misc                      (ioWarn, printSrcSpanInfo)
import           Fay.Compiler.Packages
import           Fay.Compiler.Typecheck
import           Fay.Config
import           Fay.Runtime
import qualified Fay.Exts                               as F
import           Fay.Types

import           Data.Aeson                             (encode)
import qualified Data.ByteString.Lazy                   as L
import           Language.Haskell.Exts        (prettyPrint)
import           Language.Haskell.Exts.Syntax
import           Language.Haskell.Exts.SrcLoc
import           SourceMap                              (generate)
import           SourceMap.Types
import           System.FilePath

-- | Compile the given file and write the output to the given path, or
-- if nothing given, stdout.
compileFromTo :: Config -> FilePath -> Maybe FilePath -> IO ()
compileFromTo :: Config -> FilePath -> Maybe FilePath -> IO ()
compileFromTo Config
cfg FilePath
filein Maybe FilePath
fileout =
  if Config -> Bool
configTypecheckOnly Config
cfg
  then do
    Config
cfg' <- Config -> IO Config
resolvePackages Config
cfg
    Either CompileError FilePath
res <- Config -> FilePath -> IO (Either CompileError FilePath)
typecheck Config
cfg' FilePath
filein
    (CompileError -> IO ())
-> (FilePath -> IO ()) -> Either CompileError FilePath -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ())
-> (CompileError -> FilePath) -> CompileError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileError -> FilePath
showCompileError) (Config -> FilePath -> IO ()
ioWarn Config
cfg') Either CompileError FilePath
res
  else do
    Either CompileError FilePath
result <- IO (Either CompileError FilePath)
-> (FilePath -> IO (Either CompileError FilePath))
-> Maybe FilePath
-> IO (Either CompileError FilePath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Config -> FilePath -> IO (Either CompileError FilePath)
compileFile Config
cfg FilePath
filein)
                      (Config -> FilePath -> FilePath -> IO (Either CompileError FilePath)
compileFromToAndGenerateHtml Config
cfg FilePath
filein)
                      Maybe FilePath
fileout
    case Either CompileError FilePath
result of
      Right FilePath
out -> IO () -> (FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO ()
putStrLn FilePath
out) (FilePath -> FilePath -> IO ()
`writeFile` FilePath
out) Maybe FilePath
fileout
      Left CompileError
err -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CompileError -> FilePath
showCompileError CompileError
err

-- | Compile the given file and write to the output, also generates HTML and sourcemap files if configured.
compileFromToAndGenerateHtml :: Config -> FilePath -> FilePath -> IO (Either CompileError String)
compileFromToAndGenerateHtml :: Config -> FilePath -> FilePath -> IO (Either CompileError FilePath)
compileFromToAndGenerateHtml Config
config FilePath
filein FilePath
fileout = do
  Either CompileError CompileResult
mres <- Config -> FilePath -> IO (Either CompileError CompileResult)
compileFileWithResult Config
config { configFilePath :: Maybe FilePath
configFilePath = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
filein } FilePath
filein
  case Either CompileError CompileResult
mres of
    Right CompileResult
res -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configHtmlWrapper Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> FilePath -> IO ()
writeFile (FilePath -> FilePath -> FilePath
replaceExtension FilePath
fileout FilePath
"html") (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [
            FilePath
"<!doctype html>"
          , FilePath
"<html>"
          , FilePath
"  <head>"
          ,FilePath
"    <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>"
          , [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"    "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
makeScriptTagSrc) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ Config -> [FilePath]
configHtmlJSLibs Config
config
          , FilePath
"    " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
makeScriptTagSrc FilePath
relativeJsPath
          , FilePath
"  </head>"
          , FilePath
"  <body>"
          , FilePath
"  </body>"
          , FilePath
"</html>"]

      case (Config -> Bool
configSourceMap Config
config, CompileResult -> Maybe [Mapping]
resSourceMappings CompileResult
res) of
        (Bool
True, Just [Mapping]
mappings) ->
          FilePath -> ByteString -> IO ()
L.writeFile (FilePath -> FilePath -> FilePath
replaceExtension FilePath
fileout FilePath
"map") (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
            Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$
              SourceMapping -> Value
generate SourceMapping :: FilePath -> Maybe FilePath -> [Mapping] -> SourceMapping
SourceMapping
                { smFile :: FilePath
smFile       = FilePath
fileout
                , smSourceRoot :: Maybe FilePath
smSourceRoot = Maybe FilePath
forall a. Maybe a
Nothing
                , smMappings :: [Mapping]
smMappings   = [Mapping]
mappings
                }
        (Bool, Maybe [Mapping])
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      Either CompileError FilePath -> IO (Either CompileError FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CompileError FilePath -> IO (Either CompileError FilePath))
-> Either CompileError FilePath
-> IO (Either CompileError FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either CompileError FilePath
forall a b. b -> Either a b
Right (if Config -> Bool
configSourceMap Config
config then FilePath
sourceMapHeader FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CompileResult -> FilePath
resOutput CompileResult
res else CompileResult -> FilePath
resOutput CompileResult
res)
            where relativeJsPath :: FilePath
relativeJsPath = FilePath -> FilePath -> FilePath
makeRelative (FilePath -> FilePath
dropFileName FilePath
fileout) FilePath
fileout
                  makeScriptTagSrc :: FilePath -> String
                  makeScriptTagSrc :: FilePath -> FilePath
makeScriptTagSrc FilePath
s = FilePath
"<script type=\"text/javascript\" src=\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"></script>"
                  sourceMapHeader :: FilePath
sourceMapHeader = FilePath
"//@ sourceMappingURL=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath
replaceExtension FilePath
fileout FilePath
"map" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
    Left CompileError
err -> Either CompileError FilePath -> IO (Either CompileError FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileError -> Either CompileError FilePath
forall a b. a -> Either a b
Left CompileError
err)

-- | Compile the given file.
compileFile :: Config -> FilePath -> IO (Either CompileError String)
compileFile :: Config -> FilePath -> IO (Either CompileError FilePath)
compileFile Config
config FilePath
filein = ((FilePath, Maybe [Mapping], CompileState) -> FilePath)
-> Either CompileError (FilePath, Maybe [Mapping], CompileState)
-> Either CompileError FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(FilePath
src,Maybe [Mapping]
_,CompileState
_) -> FilePath
src) (Either CompileError (FilePath, Maybe [Mapping], CompileState)
 -> Either CompileError FilePath)
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
-> IO (Either CompileError FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config
-> FilePath
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
compileFileWithState Config
config FilePath
filein

-- | Compile a file returning additional generated metadata.
compileFileWithResult :: Config -> FilePath -> IO (Either CompileError CompileResult)
compileFileWithResult :: Config -> FilePath -> IO (Either CompileError CompileResult)
compileFileWithResult Config
config FilePath
filein = do
  Either CompileError (FilePath, Maybe [Mapping], CompileState)
res <- Config
-> FilePath
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
compileFileWithState Config
config FilePath
filein
  Either CompileError CompileResult
-> IO (Either CompileError CompileResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CompileError CompileResult
 -> IO (Either CompileError CompileResult))
-> Either CompileError CompileResult
-> IO (Either CompileError CompileResult)
forall a b. (a -> b) -> a -> b
$ do
    (FilePath
s,Maybe [Mapping]
m,CompileState
st) <- Either CompileError (FilePath, Maybe [Mapping], CompileState)
res
    CompileResult -> Either CompileError CompileResult
forall (m :: * -> *) a. Monad m => a -> m a
return CompileResult :: FilePath
-> [(FilePath, FilePath)] -> Maybe [Mapping] -> CompileResult
CompileResult
      { resOutput :: FilePath
resOutput         = FilePath
s
      , resImported :: [(FilePath, FilePath)]
resImported       = ((ModuleName, FilePath) -> (FilePath, FilePath))
-> [(ModuleName, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleName -> FilePath)
-> (ModuleName, FilePath) -> (FilePath, FilePath)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ModuleName -> FilePath
forall t. ModuleName t -> FilePath
F.moduleNameString) ([(ModuleName, FilePath)] -> [(FilePath, FilePath)])
-> [(ModuleName, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ CompileState -> [(ModuleName, FilePath)]
stateImported CompileState
st
      , resSourceMappings :: Maybe [Mapping]
resSourceMappings = Maybe [Mapping]
m
      }

-- | Compile a file returning the resulting internal state of the compiler.
-- Don't use this directly, it's only exposed for the test suite.
compileFileWithState :: Config -> FilePath -> IO (Either CompileError (String,Maybe [Mapping],CompileState))
compileFileWithState :: Config
-> FilePath
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
compileFileWithState Config
config FilePath
filein = do
  FilePath
raw <- Config -> IO FilePath
readConfigRuntime Config
config
  FilePath
hscode <- FilePath -> IO FilePath
readFile FilePath
filein
  Config
config' <- Config -> IO Config
resolvePackages Config
config
  FilePath
-> Config
-> FilePath
-> (Module -> Compile [JsStmt])
-> FilePath
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
compileToModule FilePath
filein Config
config' FilePath
raw (FilePath -> Module -> Compile [JsStmt]
compileToplevelModule FilePath
filein) FilePath
hscode

-- | Compile the given module to a runnable module.
compileToModule :: FilePath
                -> Config -> String -> (F.Module -> Compile [JsStmt]) -> String
                -> IO (Either CompileError (String,Maybe [Mapping],CompileState))
compileToModule :: FilePath
-> Config
-> FilePath
-> (Module -> Compile [JsStmt])
-> FilePath
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
compileToModule FilePath
filepath Config
config FilePath
raw Module -> Compile [JsStmt]
with FilePath
hscode = do
  Either CompileError (Printer, CompileState, CompileWriter)
result <- FilePath
-> Config
-> (Module -> Compile [JsStmt])
-> FilePath
-> IO (Either CompileError (Printer, CompileState, CompileWriter))
compileViaStr FilePath
filepath Config
config Module -> Compile [JsStmt]
with FilePath
hscode
  Either CompileError (FilePath, Maybe [Mapping], CompileState)
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CompileError (FilePath, Maybe [Mapping], CompileState)
 -> IO
      (Either CompileError (FilePath, Maybe [Mapping], CompileState)))
-> Either CompileError (FilePath, Maybe [Mapping], CompileState)
-> IO
     (Either CompileError (FilePath, Maybe [Mapping], CompileState))
forall a b. (a -> b) -> a -> b
$ case Either CompileError (Printer, CompileState, CompileWriter)
result of
    Left CompileError
err -> CompileError
-> Either CompileError (FilePath, Maybe [Mapping], CompileState)
forall a b. a -> Either a b
Left CompileError
err
    Right (Printer
printer,state :: CompileState
state@CompileState{ stateModuleName :: CompileState -> ModuleName
stateModuleName = (ModuleName ()
_ FilePath
modulename) },CompileWriter
_) ->
      (FilePath, Maybe [Mapping], CompileState)
-> Either CompileError (FilePath, Maybe [Mapping], CompileState)
forall a b. b -> Either a b
Right ( PrintWriter -> FilePath
pwOutputString PrintWriter
pw
            , if [Mapping] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PrintWriter -> [Mapping]
pwMappings PrintWriter
pw) then Maybe [Mapping]
forall a. Maybe a
Nothing else [Mapping] -> Maybe [Mapping]
forall a. a -> Maybe a
Just (PrintWriter -> [Mapping]
pwMappings PrintWriter
pw)
            , CompileState
state
            )
      where
        pw :: PrintWriter
pw = Printer -> PrintReader -> PrintWriter
execPrinter (Printer
runtime Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
aliases Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
printer Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
main) PrintReader
pr
        runtime :: Printer
runtime = if Config -> Bool
configExportRuntime Config
config then FilePath -> Printer
write FilePath
raw else Printer
forall a. Monoid a => a
mempty
        aliases :: Printer
aliases = if Config -> Bool
configPrettyThunks Config
config
                  then FilePath -> Printer
write (FilePath -> Printer)
-> ([FilePath] -> FilePath) -> [FilePath] -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> Printer) -> [FilePath] -> Printer
forall a b. (a -> b) -> a -> b
$ [ FilePath
"var $ = Fay$$$;"
                                         , FilePath
"var _ = Fay$$_;"
                                         , FilePath
"var __ = Fay$$__;"
                                         ]
                  else Printer
forall a. Monoid a => a
mempty
        main :: Printer
main = if Bool -> Bool
not (Config -> Bool
configLibrary Config
config)
               then FilePath -> Printer
write (FilePath -> Printer) -> FilePath -> Printer
forall a b. (a -> b) -> a -> b
$ FilePath
"Fay$$_(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
modulename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".main, true);\n"
               else Printer
forall a. Monoid a => a
mempty
        pr :: PrintReader
pr = PrintReader
defaultPrintReader
          { prPrettyThunks :: Bool
prPrettyThunks    = Config -> Bool
configPrettyThunks Config
config
          , prPretty :: Bool
prPretty          = Config -> Bool
configPrettyPrint Config
config
          , prPrettyOperators :: Bool
prPrettyOperators = Config -> Bool
configPrettyOperators Config
config
          }

-- | Convert a Haskell filename to a JS filename.
toJsName :: String -> String
toJsName :: FilePath -> FilePath
toJsName FilePath
x = case FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
x of
  (Char
's':Char
'h':Char
'.': (FilePath -> FilePath
forall a. [a] -> [a]
reverse -> FilePath
file)) -> FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".js"
  FilePath
_ -> FilePath
x

-- | Convert a Haskell filename to a TypeScript filename.
toTsName :: String -> String
toTsName :: FilePath -> FilePath
toTsName FilePath
x = case FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
x of
  (Char
's':Char
'h':Char
'.': (FilePath -> FilePath
forall a. [a] -> [a]
reverse -> FilePath
file)) -> FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".ts"
  FilePath
_ -> FilePath
x

-- | Print a compile error for human consumption.
showCompileError :: CompileError -> String
showCompileError :: CompileError -> FilePath
showCompileError CompileError
e = case CompileError
e of
  Couldn'tFindImport ModuleName
i [FilePath]
places      ->
    FilePath
"could not find an import in the path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ModuleName
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", \n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    FilePath
"searched in these places: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
places
  CompileError
EmptyDoBlock -> FilePath
"empty `do' block"
  FfiFormatBadChars SrcSpanInfo
srcloc FilePath
cs      -> SrcSpanInfo -> FilePath
printSrcSpanInfo SrcSpanInfo
srcloc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": invalid characters for FFI format string: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
cs
  FfiFormatIncompleteArg SrcSpanInfo
srcloc    -> SrcSpanInfo -> FilePath
printSrcSpanInfo SrcSpanInfo
srcloc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": incomplete `%' syntax in FFI format string"
  FfiFormatInvalidJavaScript SrcSpanInfo
l FilePath
c FilePath
m ->
    SrcSpanInfo -> FilePath
printSrcSpanInfo SrcSpanInfo
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    FilePath
"\ninvalid JavaScript code in FFI format string:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
m FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\nin " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
c
  FfiFormatNoSuchArg SrcSpanInfo
srcloc Int
i      ->
    SrcSpanInfo -> FilePath
printSrcSpanInfo SrcSpanInfo
srcloc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    FilePath
"\nno such argument in FFI format string: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i
  FfiNeedsTypeSig Exp
d                -> FilePath
"your FFI declaration needs a type signature: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp
d
  GHCError FilePath
s                       -> FilePath
"ghc: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
  CompileError
InvalidDoBlock                   -> FilePath
"invalid `do' block"
  ParseError SrcLoc
pos FilePath
err               ->
    FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" at line: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (SrcLoc -> Int
srcLine SrcLoc
pos) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" column:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (SrcLoc -> Int
srcColumn SrcLoc
pos)
  ShouldBeDesugared FilePath
s              -> FilePath
"Expected this to be desugared (this is a bug): " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
  UnableResolveQualified QName
qname     -> FilePath
"unable to resolve qualified names (this might be a bug):" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ QName -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint QName
qname
  UnsupportedDeclaration Decl
d         -> FilePath
"unsupported declaration: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Decl -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Decl
d
  UnsupportedEnum{}                -> FilePath
"only Int is allowed in enum expressions"
  UnsupportedExportSpec ExportSpec
es         -> FilePath
"unsupported export specification: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExportSpec -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ExportSpec
es
  UnsupportedExpression Exp
expr       -> FilePath
"unsupported expression syntax: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp
expr
  UnsupportedFieldPattern PatField
p        -> FilePath
"unsupported field pattern: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PatField -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint PatField
p
  UnsupportedImport ImportDecl
i              -> FilePath
"unsupported import syntax: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ImportDecl -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ImportDecl
i
  CompileError
UnsupportedLet                   -> FilePath
"let not supported here"
  UnsupportedLetBinding Decl
d          -> FilePath
"unsupported let binding: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Decl -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Decl
d
  UnsupportedLiteral Literal
lit           -> FilePath
"unsupported literal syntax: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Literal -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Literal
lit
  UnsupportedModuleSyntax FilePath
s Module
m      -> FilePath
"unsupported module syntax in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Module -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Module
m
  UnsupportedPattern Pat
pat           -> FilePath
"unsupported pattern syntax: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Pat -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Pat
pat
  UnsupportedQualStmt QualStmt
stmt         -> FilePath
"unsupported list qualifier: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ QualStmt -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint QualStmt
stmt
  CompileError
UnsupportedRecursiveDo           -> FilePath
"recursive `do' isn't supported"
  UnsupportedRhs Rhs
rhs               -> FilePath
"unsupported right-hand side syntax: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Rhs -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Rhs
rhs
  UnsupportedWhereInAlt Alt
alt        -> FilePath
"`where' not supported here: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Alt -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Alt
alt
  UnsupportedWhereInMatch Match
m        -> FilePath
"unsupported `where' syntax: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Match -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Match
m

-- | Get the JS runtime source.
-- This will return the user supplied runtime if it exists.
readConfigRuntime :: Config -> IO String
readConfigRuntime :: Config -> IO FilePath
readConfigRuntime Config
cfg =
  case Config -> Maybe FilePath
configRuntimePath Config
cfg of
    Just FilePath
path -> FilePath -> IO FilePath
readFile FilePath
path
    Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Config -> FilePath
getRuntimeSource Config
cfg