module Fay.Types
(JsStmt(..)
,JsExp(..)
,JsLit(..)
,JsName(..)
,CompileError(..)
,Compile(..)
,CompileModule
,Printable(..)
,Fay
,CompileReader(..)
,CompileWriter(..)
,Config(..)
,CompileState(..)
,FundamentalType(..)
,PrintState(..)
,defaultPrintState
,PrintReader(..)
,defaultPrintReader
,PrintWriter(..)
,Printer(..)
,execPrinter
,askP
,getP
,modifyP
,tellP
,whenP
,SerializeContext(..)
,ModulePath (unModulePath)
,mkModulePath
,mkModulePaths
,mkModulePathFromQName
) where
import Fay.Compiler.Prelude
import Fay.Config
import qualified Fay.Exts.NoAnnotation as N
import qualified Fay.Exts.Scoped as S
import Fay.Types.CompileError
import Fay.Types.FFI
import Fay.Types.Js
import Fay.Types.ModulePath
import Control.Monad.Error (ErrorT, MonadError)
import Control.Monad.Identity (Identity)
import Control.Monad.RWS
import Data.Map (Map)
import Data.Set (Set)
import Distribution.HaskellSuite.Modules
import Language.Haskell.Names (Symbols)
import SourceMap.Types
data CompileState = CompileState
{ stateInterfaces :: Map N.ModuleName Symbols
, stateRecordTypes :: [(N.QName,[N.QName])]
, stateRecords :: [(N.QName,[N.Name])]
, stateNewtypes :: [(N.QName, Maybe N.QName, N.Type)]
, stateImported :: [(N.ModuleName,FilePath)]
, stateNameDepth :: Integer
, stateModuleName :: N.ModuleName
, stateJsModulePaths :: Set ModulePath
, stateUseFromString :: Bool
, stateTypeSigs :: Map N.QName N.Type
} deriving (Show)
data CompileWriter = CompileWriter
{ writerCons :: [JsStmt]
, writerFayToJs :: [(String,JsExp)]
, writerJsToFay :: [(String,JsExp)]
} deriving (Show)
instance Monoid CompileWriter where
mempty = CompileWriter [] [] []
mappend (CompileWriter a b c) (CompileWriter x y z) =
CompileWriter (a++x) (b++y) (c++z)
data CompileReader = CompileReader
{ readerConfig :: Config
, readerCompileLit :: S.Sign -> S.Literal -> Compile JsExp
, readerCompileDecls :: Bool -> [S.Decl] -> Compile [JsStmt]
}
newtype Compile a = Compile
{ unCompile :: RWST CompileReader CompileWriter CompileState
(ErrorT CompileError (ModuleT (ModuleInfo Compile) IO))
a
} deriving
( Applicative
, Functor
, Monad
, MonadError CompileError
, MonadIO
, MonadReader CompileReader
, MonadState CompileState
, MonadWriter CompileWriter
)
type CompileModule a = ModuleT Symbols IO (Either CompileError (a, CompileState, CompileWriter))
instance MonadModule Compile where
type ModuleInfo Compile = Symbols
lookupInCache = liftModuleT . lookupInCache
insertInCache n m = liftModuleT $ insertInCache n m
getPackages = liftModuleT getPackages
readModuleInfo fps n = liftModuleT $ readModuleInfo fps n
liftModuleT :: ModuleT Symbols IO a -> Compile a
liftModuleT = Compile . lift . lift
data PrintReader = PrintReader
{ prPretty :: Bool
, prPrettyThunks :: Bool
}
defaultPrintReader :: PrintReader
defaultPrintReader = PrintReader False False
data PrintWriter = PrintWriter
{ pwMappings :: [Mapping]
, pwOutput :: [String]
}
instance Monoid PrintWriter where
mempty = PrintWriter [] []
mappend (PrintWriter a b) (PrintWriter x y) = PrintWriter (x ++ a) (y ++ b)
data PrintState = PrintState
{ psLine :: Int
, psColumn :: Int
, psIndentLevel :: Int
, psNewline :: Bool
}
defaultPrintState :: PrintState
defaultPrintState = PrintState 0 0 0 False
newtype Printer = Printer
{ runPrinter :: RWS PrintReader PrintWriter PrintState ()
}
execPrinter :: Printer -> PrintReader -> PrintWriter
execPrinter (Printer p) r = snd $ execRWS p r defaultPrintState
askP :: (PrintReader -> Printer) -> Printer
askP f = Printer $ ask >>= (\r -> runPrinter (f r))
getP :: (PrintState -> Printer) -> Printer
getP f = Printer $ get >>= (\s -> runPrinter (f s))
modifyP :: (PrintState -> PrintState) -> Printer
modifyP f = Printer $ modify f
tellP :: PrintWriter -> Printer
tellP = Printer . tell
whenP :: Bool -> Printer -> Printer
whenP b p = if b then p else mempty
instance Monoid Printer where
mempty = Printer $ return ()
mappend (Printer p) (Printer q) = Printer (p >> q)
class Printable a where
printJS :: a -> Printer
newtype Fay a = Fay (Identity a)
deriving
( Applicative
, Functor
, Monad
)