{-# LANGUAGE NoImplicitPrelude #-}
-- | Configuring the compiler
module Fay.Config
  ( Config
      ( configOptimize
      , configFlattenApps
      , configExportRuntime
      , configExportStdlib
      , configExportStdlibOnly
      , configPrettyPrint
      , configHtmlWrapper
      , configSourceMap
      , configHtmlJSLibs
      , configLibrary
      , configWarn
      , configFilePath
      , configTypecheck
      , configWall
      , configGClosure
      , configPackageConf
      , configBasePath
      , configStrict
      , configTypecheckOnly
      , configRuntimePath
      , configOptimizeNewtypes
      , configPrettyThunks
      , configPrettyOperators
      , configShowGhcCalls
      , configTypeScript
      )
  , defaultConfig
  , defaultConfigWithSandbox
  , configDirectoryIncludes
  , configDirectoryIncludePaths
  , nonPackageConfigDirectoryIncludePaths
  , addConfigDirectoryInclude
  , addConfigDirectoryIncludes
  , addConfigDirectoryIncludePaths
  , configPackages
  , addConfigPackage
  , addConfigPackages
  , shouldExportStrictWrapper
  ) where

import           Fay.Compiler.Prelude

import           Data.Default
import           Data.Maybe                      ()
import           Language.Haskell.Exts (ModuleName (..))
import           System.Environment

-- | Configuration of the compiler.
-- The fields with a leading underscore
data Config = Config
  { Config -> Bool
configOptimize           :: Bool                        -- ^ Run optimizations
  , Config -> Bool
configFlattenApps        :: Bool                        -- ^ Flatten function application?
  , Config -> Bool
configExportRuntime      :: Bool                        -- ^ Export the runtime?
  , Config -> Bool
configExportStdlib       :: Bool                        -- ^ Export the stdlib?
  , Config -> Bool
configExportStdlibOnly   :: Bool                        -- ^ Export /only/ the stdlib?
  , Config -> [(Maybe String, String)]
_configDirectoryIncludes :: [(Maybe String, FilePath)]  -- ^ Possibly a fay package name, and a include directory.
  , Config -> Bool
configPrettyPrint        :: Bool                        -- ^ Pretty print the JS output?
  , Config -> Bool
configHtmlWrapper        :: Bool                        -- ^ Output a HTML file including the produced JS.
  , Config -> Bool
configSourceMap          :: Bool                        -- ^ Output a source map file as outfile.map.
  , Config -> [String]
configHtmlJSLibs         :: [FilePath]                  -- ^ Any JS files to link to in the HTML.
  , Config -> Bool
configLibrary            :: Bool                        -- ^ Don't invoke main in the produced JS.
  , Config -> Bool
configWarn               :: Bool                        -- ^ Warn on dubious stuff, not related to typechecking.
  , Config -> Maybe String
configFilePath           :: Maybe FilePath              -- ^ File path to output to.
  , Config -> Bool
configTypecheck          :: Bool                        -- ^ Typecheck with GHC.
  , Config -> Bool
configWall               :: Bool                        -- ^ Typecheck with -Wall.
  , Config -> Bool
configGClosure           :: Bool                        -- ^ Run Google Closure on the produced JS.
  , Config -> Maybe String
configPackageConf        :: Maybe FilePath              -- ^ The package config e.g. packages-6.12.3.
  , Config -> [String]
_configPackages          :: [String]                    -- ^ Included Fay packages.
  , Config -> Maybe String
configBasePath           :: Maybe FilePath              -- ^ Custom source location for fay-base
  , Config -> [String]
configStrict             :: [String]                    -- ^ Produce strict and uncurried JavaScript callable wrappers for all
                                                            --   exported functions with type signatures in the given module
  , Config -> Bool
configTypecheckOnly      :: Bool                        -- ^ Only invoke GHC for typechecking, don't produce any output
  , Config -> Maybe String
configRuntimePath        :: Maybe FilePath
  , Config -> Bool
configOptimizeNewtypes   :: Bool                        -- ^ Optimize away newtype constructors?
  , Config -> Bool
configPrettyThunks       :: Bool                        -- ^ Use pretty thunk names?
  , Config -> Bool
configPrettyOperators    :: Bool                        -- ^ Use pretty operators?
  , Config -> Bool
configShowGhcCalls       :: Bool                        -- ^ Print commands sent to GHC?
  , Config -> Bool
configTypeScript         :: Bool                        -- ^ Output a TypeScript file.
  } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = String -> Config -> Config
addConfigPackage String
"fay-base"
  Config :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [(Maybe String, String)]
-> Bool
-> Bool
-> Bool
-> [String]
-> Bool
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> Maybe String
-> [String]
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Config
Config
    { configOptimize :: Bool
configOptimize           = Bool
False
    , configFlattenApps :: Bool
configFlattenApps        = Bool
False
    , configExportRuntime :: Bool
configExportRuntime      = Bool
True
    , configExportStdlib :: Bool
configExportStdlib       = Bool
True
    , configExportStdlibOnly :: Bool
configExportStdlibOnly   = Bool
False
    , _configDirectoryIncludes :: [(Maybe String, String)]
_configDirectoryIncludes = []
    , configPrettyPrint :: Bool
configPrettyPrint        = Bool
False
    , configHtmlWrapper :: Bool
configHtmlWrapper        = Bool
False
    , configHtmlJSLibs :: [String]
configHtmlJSLibs         = []
    , configLibrary :: Bool
configLibrary            = Bool
False
    , configWarn :: Bool
configWarn               = Bool
True
    , configFilePath :: Maybe String
configFilePath           = Maybe String
forall a. Maybe a
Nothing
    , configTypecheck :: Bool
configTypecheck          = Bool
True
    , configWall :: Bool
configWall               = Bool
False
    , configGClosure :: Bool
configGClosure           = Bool
False
    , configPackageConf :: Maybe String
configPackageConf        = Maybe String
forall a. Maybe a
Nothing
    , _configPackages :: [String]
_configPackages          = []
    , configBasePath :: Maybe String
configBasePath           = Maybe String
forall a. Maybe a
Nothing
    , configStrict :: [String]
configStrict             = []
    , configTypecheckOnly :: Bool
configTypecheckOnly      = Bool
False
    , configRuntimePath :: Maybe String
configRuntimePath        = Maybe String
forall a. Maybe a
Nothing
    , configSourceMap :: Bool
configSourceMap          = Bool
False
    , configOptimizeNewtypes :: Bool
configOptimizeNewtypes   = Bool
True
    , configPrettyThunks :: Bool
configPrettyThunks       = Bool
False
    , configPrettyOperators :: Bool
configPrettyOperators    = Bool
False
    , configShowGhcCalls :: Bool
configShowGhcCalls       = Bool
False
    , configTypeScript :: Bool
configTypeScript         = Bool
False
    }

defaultConfigWithSandbox :: IO Config
defaultConfigWithSandbox :: IO Config
defaultConfigWithSandbox = do
  Maybe String
packageConf <- ([(String, String)] -> Maybe String)
-> IO [(String, String)] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"HASKELL_PACKAGE_SANDBOX") IO [(String, String)]
getEnvironment
  Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig { configPackageConf :: Maybe String
configPackageConf = Maybe String
packageConf }

-- | Default configuration.
instance Default Config where
  def :: Config
def = Config
defaultConfig

-- | Reading _configDirectoryIncludes is safe to do.
configDirectoryIncludes :: Config -> [(Maybe String, FilePath)]
configDirectoryIncludes :: Config -> [(Maybe String, String)]
configDirectoryIncludes = Config -> [(Maybe String, String)]
_configDirectoryIncludes

-- | Get all include directories without the package mapping.
configDirectoryIncludePaths :: Config -> [FilePath]
configDirectoryIncludePaths :: Config -> [String]
configDirectoryIncludePaths = ((Maybe String, String) -> String)
-> [(Maybe String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String, String) -> String
forall a b. (a, b) -> b
snd ([(Maybe String, String)] -> [String])
-> (Config -> [(Maybe String, String)]) -> Config -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [(Maybe String, String)]
_configDirectoryIncludes

-- | Get all include directories not included through packages.
nonPackageConfigDirectoryIncludePaths :: Config -> [FilePath]
nonPackageConfigDirectoryIncludePaths :: Config -> [String]
nonPackageConfigDirectoryIncludePaths = ((Maybe String, String) -> String)
-> [(Maybe String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String, String) -> String
forall a b. (a, b) -> b
snd ([(Maybe String, String)] -> [String])
-> (Config -> [(Maybe String, String)]) -> Config -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe String, String) -> Bool)
-> [(Maybe String, String)] -> [(Maybe String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> ((Maybe String, String) -> Maybe String)
-> (Maybe String, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String, String) -> Maybe String
forall a b. (a, b) -> a
fst) ([(Maybe String, String)] -> [(Maybe String, String)])
-> (Config -> [(Maybe String, String)])
-> Config
-> [(Maybe String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [(Maybe String, String)]
_configDirectoryIncludes

-- | Add a mapping from (maybe) a package to a source directory
addConfigDirectoryInclude :: Maybe String -> FilePath -> Config -> Config
addConfigDirectoryInclude :: Maybe String -> String -> Config -> Config
addConfigDirectoryInclude Maybe String
pkg String
fp Config
cfg = Config
cfg { _configDirectoryIncludes :: [(Maybe String, String)]
_configDirectoryIncludes = (Maybe String
pkg, String
fp) (Maybe String, String)
-> [(Maybe String, String)] -> [(Maybe String, String)]
forall a. a -> [a] -> [a]
: Config -> [(Maybe String, String)]
_configDirectoryIncludes Config
cfg }

-- | Add several include directories.
addConfigDirectoryIncludes :: [(Maybe String,FilePath)] -> Config -> Config
addConfigDirectoryIncludes :: [(Maybe String, String)] -> Config -> Config
addConfigDirectoryIncludes [(Maybe String, String)]
pkgFps Config
cfg = (Config -> (Maybe String, String) -> Config)
-> Config -> [(Maybe String, String)] -> Config
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Config
c (Maybe String
pkg,String
fp) -> Maybe String -> String -> Config -> Config
addConfigDirectoryInclude Maybe String
pkg String
fp Config
c) Config
cfg [(Maybe String, String)]
pkgFps

-- | Add several include directories without package references.
addConfigDirectoryIncludePaths :: [FilePath] -> Config -> Config
addConfigDirectoryIncludePaths :: [String] -> Config -> Config
addConfigDirectoryIncludePaths [String]
fps Config
cfg = (Config -> String -> Config) -> Config -> [String] -> Config
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((String -> Config -> Config) -> Config -> String -> Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe String -> String -> Config -> Config
addConfigDirectoryInclude Maybe String
forall a. Maybe a
Nothing)) Config
cfg [String]
fps

-- | Reading _configPackages is safe to do.
configPackages :: Config -> [String]
configPackages :: Config -> [String]
configPackages = Config -> [String]
_configPackages

-- | Add a package to compilation
addConfigPackage :: String -> Config -> Config
addConfigPackage :: String -> Config -> Config
addConfigPackage String
pkg Config
cfg = Config
cfg { _configPackages :: [String]
_configPackages = String
pkg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Config -> [String]
_configPackages Config
cfg }

-- | Add several packages to compilation
addConfigPackages :: [String] -> Config -> Config
addConfigPackages :: [String] -> Config -> Config
addConfigPackages [String]
fps Config
cfg = (Config -> String -> Config) -> Config -> [String] -> Config
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((String -> Config -> Config) -> Config -> String -> Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Config -> Config
addConfigPackage) Config
cfg [String]
fps


-- | Should a strict wrapper be generated for this module?
shouldExportStrictWrapper :: ModuleName a -> Config -> Bool
shouldExportStrictWrapper :: ModuleName a -> Config -> Bool
shouldExportStrictWrapper (ModuleName a
_ String
m) Config
cs = String
m String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Config -> [String]
configStrict Config
cs