{-# LANGUAGE OverloadedStrings #-}

-- | Default values.

module Fay.Compiler.Defaults where

import           Fay.Compiler.Decl (compileDecls)
import           Fay.Compiler.Exp  (compileLit)
import           Fay.Config
import           Fay.Types
import           Paths_fay

import           Data.Map          as M
import           Data.Set          as S

-- | The data-files source directory.
faySourceDir :: IO FilePath
faySourceDir :: IO FilePath
faySourceDir = FilePath -> IO FilePath
getDataFileName FilePath
"src/"

-- | The default compiler reader value.
defaultCompileReader :: Config -> IO CompileReader
defaultCompileReader :: Config -> IO CompileReader
defaultCompileReader Config
config = do
  FilePath
srcdir <- IO FilePath
faySourceDir
  CompileReader -> IO CompileReader
forall (m :: * -> *) a. Monad m => a -> m a
return CompileReader :: Config
-> (Sign -> Literal -> Compile JsExp)
-> (Bool -> [Decl] -> Compile [JsStmt])
-> CompileReader
CompileReader
    { readerConfig :: Config
readerConfig = Maybe FilePath -> FilePath -> Config -> Config
addConfigDirectoryInclude Maybe FilePath
forall a. Maybe a
Nothing FilePath
srcdir Config
config
    , readerCompileLit :: Sign -> Literal -> Compile JsExp
readerCompileLit = Sign -> Literal -> Compile JsExp
compileLit
    , readerCompileDecls :: Bool -> [Decl] -> Compile [JsStmt]
readerCompileDecls = Bool -> [Decl] -> Compile [JsStmt]
compileDecls
    }

-- | The default compiler state.
defaultCompileState :: CompileState
defaultCompileState :: CompileState
defaultCompileState = CompileState :: Map ModuleName Symbols
-> [(QName, [QName])]
-> [(QName, [Name])]
-> [(QName, Maybe QName, Type)]
-> [(ModuleName, FilePath)]
-> Integer
-> ModuleName
-> Set ModulePath
-> Bool
-> Map QName Type
-> CompileState
CompileState
  { stateInterfaces :: Map ModuleName Symbols
stateInterfaces    = Map ModuleName Symbols
forall k a. Map k a
M.empty
  , stateModuleName :: ModuleName
stateModuleName    = ModuleName
"Main"
  , stateRecordTypes :: [(QName, [QName])]
stateRecordTypes   = []
  , stateRecords :: [(QName, [Name])]
stateRecords       = []
  , stateNewtypes :: [(QName, Maybe QName, Type)]
stateNewtypes      = []
  , stateImported :: [(ModuleName, FilePath)]
stateImported      = []
  , stateNameDepth :: Integer
stateNameDepth     = Integer
1
  , stateJsModulePaths :: Set ModulePath
stateJsModulePaths = Set ModulePath
forall a. Set a
S.empty
  , stateUseFromString :: Bool
stateUseFromString = Bool
False
  , stateTypeSigs :: Map QName Type
stateTypeSigs      = Map QName Type
forall k a. Map k a
M.empty
  }