{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE TypeFamilies               #-}

-- | All Fay types and instances.

module Fay.Types
  ( JsStmt(..)
  , JsExp(..)
  , JsLit(..)
  , JsName(..)
  , CompileError(..)
  , Compile(..)
  , CompileModule
  , Printable(..)
  , Fay
  , CompileReader(..)
  , CompileResult(..)
  , CompileWriter(..)
  , Config(..)
  , CompileState(..)
  , FundamentalType(..)
  , PrintState(..)
  , defaultPrintState
  , PrintReader(..)
  , defaultPrintReader
  , PrintWriter(..)
  , pwOutputString
  , Printer(..)
  , execPrinter
  , indented
  , askIf
  , newline
  , write
  , mapping
  , SerializeContext(..)
  , ModulePath (unModulePath)
  , mkModulePath
  , mkModulePaths
  , mkModulePathFromQName
  ) where

import           Fay.Compiler.Prelude

import           Fay.Compiler.ModuleT
import           Fay.Config
import qualified Fay.Exts.NoAnnotation   as N
import qualified Fay.Exts.Scoped         as S
import           Fay.Types.CompileError
import           Fay.Types.CompileResult
import           Fay.Types.FFI
import           Fay.Types.Js
import           Fay.Types.ModulePath
import           Fay.Types.Printer

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
#endif
import           Control.Monad.Except    (ExceptT, MonadError)
import           Control.Monad.Identity  (Identity)
import           Control.Monad.RWS       (MonadIO, MonadReader, MonadState, MonadWriter, RWST, lift)
import           Data.Map                (Map)
import           Data.Set                (Set)
import           Language.Haskell.Names  (Symbols)
import           Data.Semigroup          (Semigroup)

--------------------------------------------------------------------------------
-- Compiler types

-- | State of the compiler.
data CompileState = CompileState
  -- TODO Change N.QName to GName? They can never be special so it would simplify.
  { CompileState -> Map ModuleName Symbols
stateInterfaces    :: Map N.ModuleName Symbols           -- ^ Exported identifiers for all modules
  , CompileState -> [(QName, [QName])]
stateRecordTypes   :: [(N.QName,[N.QName])]              -- ^ Map types to constructors
  , CompileState -> [(QName, [Name])]
stateRecords       :: [(N.QName,[N.Name])]               -- ^ Map constructors to fields
  , CompileState -> [(QName, Maybe QName, Type)]
stateNewtypes      :: [(N.QName, Maybe N.QName, N.Type)] -- ^ Newtype constructor, destructor, wrapped type tuple
  , CompileState -> [(ModuleName, FilePath)]
stateImported      :: [(N.ModuleName,FilePath)]          -- ^ Map of all imported modules and their source locations.
  , CompileState -> Integer
stateNameDepth     :: Integer                            -- ^ Depth of the current lexical scope, used for creating unshadowing variables.
  , CompileState -> ModuleName
stateModuleName    :: N.ModuleName                       -- ^ Name of the module currently being compiled.
  , CompileState -> Set ModulePath
stateJsModulePaths :: Set ModulePath                     -- ^ Module paths that have code generated for them.
  , CompileState -> Bool
stateUseFromString :: Bool                               -- ^ Use JS Strings instead of [Char] for string literals?
  , CompileState -> Map QName Type
stateTypeSigs      :: Map N.QName N.Type                 -- ^ Module level declarations having explicit type signatures
  } deriving (Int -> CompileState -> ShowS
[CompileState] -> ShowS
CompileState -> FilePath
(Int -> CompileState -> ShowS)
-> (CompileState -> FilePath)
-> ([CompileState] -> ShowS)
-> Show CompileState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompileState] -> ShowS
$cshowList :: [CompileState] -> ShowS
show :: CompileState -> FilePath
$cshow :: CompileState -> FilePath
showsPrec :: Int -> CompileState -> ShowS
$cshowsPrec :: Int -> CompileState -> ShowS
Show)

-- | Things written out by the compiler.
data CompileWriter = CompileWriter
  { CompileWriter -> [JsStmt]
writerCons    :: [JsStmt]         -- ^ Constructors.
  , CompileWriter -> [(FilePath, JsExp)]
writerFayToJs :: [(String,JsExp)] -- ^ Fay to JS dispatchers.
  , CompileWriter -> [(FilePath, JsExp)]
writerJsToFay :: [(String,JsExp)] -- ^ JS to Fay dispatchers.
  } deriving (Int -> CompileWriter -> ShowS
[CompileWriter] -> ShowS
CompileWriter -> FilePath
(Int -> CompileWriter -> ShowS)
-> (CompileWriter -> FilePath)
-> ([CompileWriter] -> ShowS)
-> Show CompileWriter
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompileWriter] -> ShowS
$cshowList :: [CompileWriter] -> ShowS
show :: CompileWriter -> FilePath
$cshow :: CompileWriter -> FilePath
showsPrec :: Int -> CompileWriter -> ShowS
$cshowsPrec :: Int -> CompileWriter -> ShowS
Show)

-- | Simple concatenating instance.
instance Semigroup CompileWriter where
  (CompileWriter [JsStmt]
a [(FilePath, JsExp)]
b [(FilePath, JsExp)]
c) <> :: CompileWriter -> CompileWriter -> CompileWriter
<> (CompileWriter [JsStmt]
x [(FilePath, JsExp)]
y [(FilePath, JsExp)]
z) =
    [JsStmt]
-> [(FilePath, JsExp)] -> [(FilePath, JsExp)] -> CompileWriter
CompileWriter ([JsStmt]
a[JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++[JsStmt]
x) ([(FilePath, JsExp)]
b[(FilePath, JsExp)] -> [(FilePath, JsExp)] -> [(FilePath, JsExp)]
forall a. [a] -> [a] -> [a]
++[(FilePath, JsExp)]
y) ([(FilePath, JsExp)]
c[(FilePath, JsExp)] -> [(FilePath, JsExp)] -> [(FilePath, JsExp)]
forall a. [a] -> [a] -> [a]
++[(FilePath, JsExp)]
z)

-- | Simple concatenating instance.
instance Monoid CompileWriter where
  mempty :: CompileWriter
mempty = [JsStmt]
-> [(FilePath, JsExp)] -> [(FilePath, JsExp)] -> CompileWriter
CompileWriter [] [] []
  mappend :: CompileWriter -> CompileWriter -> CompileWriter
mappend = CompileWriter -> CompileWriter -> CompileWriter
forall a. Semigroup a => a -> a -> a
(<>)

-- | Configuration and globals for the compiler.
data CompileReader = CompileReader
  { CompileReader -> Config
readerConfig       :: Config -- ^ The compilation configuration.
  , CompileReader -> Sign -> Literal -> Compile JsExp
readerCompileLit   :: S.Sign -> S.Literal -> Compile JsExp
  , CompileReader -> Bool -> [Decl] -> Compile [JsStmt]
readerCompileDecls :: Bool -> [S.Decl] -> Compile [JsStmt]
  }

-- | Compile monad.
newtype Compile a = Compile
  { Compile a
-> RWST
     CompileReader
     CompileWriter
     CompileState
     (ExceptT CompileError (ModuleT (ModuleInfo Compile) IO))
     a
unCompile :: RWST CompileReader CompileWriter CompileState
                      (ExceptT CompileError (ModuleT (ModuleInfo Compile) IO))
                      a -- ^ Uns the compiler
  } deriving
    ( Functor Compile
a -> Compile a
Functor Compile
-> (forall a. a -> Compile a)
-> (forall a b. Compile (a -> b) -> Compile a -> Compile b)
-> (forall a b c.
    (a -> b -> c) -> Compile a -> Compile b -> Compile c)
-> (forall a b. Compile a -> Compile b -> Compile b)
-> (forall a b. Compile a -> Compile b -> Compile a)
-> Applicative Compile
Compile a -> Compile b -> Compile b
Compile a -> Compile b -> Compile a
Compile (a -> b) -> Compile a -> Compile b
(a -> b -> c) -> Compile a -> Compile b -> Compile c
forall a. a -> Compile a
forall a b. Compile a -> Compile b -> Compile a
forall a b. Compile a -> Compile b -> Compile b
forall a b. Compile (a -> b) -> Compile a -> Compile b
forall a b c. (a -> b -> c) -> Compile a -> Compile b -> Compile c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Compile a -> Compile b -> Compile a
$c<* :: forall a b. Compile a -> Compile b -> Compile a
*> :: Compile a -> Compile b -> Compile b
$c*> :: forall a b. Compile a -> Compile b -> Compile b
liftA2 :: (a -> b -> c) -> Compile a -> Compile b -> Compile c
$cliftA2 :: forall a b c. (a -> b -> c) -> Compile a -> Compile b -> Compile c
<*> :: Compile (a -> b) -> Compile a -> Compile b
$c<*> :: forall a b. Compile (a -> b) -> Compile a -> Compile b
pure :: a -> Compile a
$cpure :: forall a. a -> Compile a
$cp1Applicative :: Functor Compile
Applicative
    , a -> Compile b -> Compile a
(a -> b) -> Compile a -> Compile b
(forall a b. (a -> b) -> Compile a -> Compile b)
-> (forall a b. a -> Compile b -> Compile a) -> Functor Compile
forall a b. a -> Compile b -> Compile a
forall a b. (a -> b) -> Compile a -> Compile b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Compile b -> Compile a
$c<$ :: forall a b. a -> Compile b -> Compile a
fmap :: (a -> b) -> Compile a -> Compile b
$cfmap :: forall a b. (a -> b) -> Compile a -> Compile b
Functor
    , Applicative Compile
a -> Compile a
Applicative Compile
-> (forall a b. Compile a -> (a -> Compile b) -> Compile b)
-> (forall a b. Compile a -> Compile b -> Compile b)
-> (forall a. a -> Compile a)
-> Monad Compile
Compile a -> (a -> Compile b) -> Compile b
Compile a -> Compile b -> Compile b
forall a. a -> Compile a
forall a b. Compile a -> Compile b -> Compile b
forall a b. Compile a -> (a -> Compile b) -> Compile b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Compile a
$creturn :: forall a. a -> Compile a
>> :: Compile a -> Compile b -> Compile b
$c>> :: forall a b. Compile a -> Compile b -> Compile b
>>= :: Compile a -> (a -> Compile b) -> Compile b
$c>>= :: forall a b. Compile a -> (a -> Compile b) -> Compile b
$cp1Monad :: Applicative Compile
Monad
    , MonadError CompileError
    , Monad Compile
Monad Compile -> (forall a. IO a -> Compile a) -> MonadIO Compile
IO a -> Compile a
forall a. IO a -> Compile a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Compile a
$cliftIO :: forall a. IO a -> Compile a
$cp1MonadIO :: Monad Compile
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 :: n -> Compile (Maybe (ModuleInfo Compile))
lookupInCache        = ModuleT Symbols IO (Maybe Symbols) -> Compile (Maybe Symbols)
forall a. ModuleT Symbols IO a -> Compile a
liftModuleT (ModuleT Symbols IO (Maybe Symbols) -> Compile (Maybe Symbols))
-> (n -> ModuleT Symbols IO (Maybe Symbols))
-> n
-> Compile (Maybe Symbols)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> ModuleT Symbols IO (Maybe Symbols)
forall (m :: * -> *) n.
(MonadModule m, ModName n) =>
n -> m (Maybe (ModuleInfo m))
lookupInCache
  insertInCache :: n -> ModuleInfo Compile -> Compile ()
insertInCache n
n ModuleInfo Compile
m    = ModuleT Symbols IO () -> Compile ()
forall a. ModuleT Symbols IO a -> Compile a
liftModuleT (ModuleT Symbols IO () -> Compile ())
-> ModuleT Symbols IO () -> Compile ()
forall a b. (a -> b) -> a -> b
$ n -> ModuleInfo (ModuleT Symbols IO) -> ModuleT Symbols IO ()
forall (m :: * -> *) n.
(MonadModule m, ModName n) =>
n -> ModuleInfo m -> m ()
insertInCache n
n ModuleInfo (ModuleT Symbols IO)
ModuleInfo Compile
m
  readModuleInfo :: [FilePath] -> n -> Compile (ModuleInfo Compile)
readModuleInfo [FilePath]
fps n
n = ModuleT Symbols IO Symbols -> Compile Symbols
forall a. ModuleT Symbols IO a -> Compile a
liftModuleT (ModuleT Symbols IO Symbols -> Compile Symbols)
-> ModuleT Symbols IO Symbols -> Compile Symbols
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> n -> ModuleT Symbols IO (ModuleInfo (ModuleT Symbols IO))
forall (m :: * -> *) n.
(MonadModule m, ModName n) =>
[FilePath] -> n -> m (ModuleInfo m)
readModuleInfo [FilePath]
fps n
n

liftModuleT :: ModuleT Symbols IO a -> Compile a
liftModuleT :: ModuleT Symbols IO a -> Compile a
liftModuleT = RWST
  CompileReader
  CompileWriter
  CompileState
  (ExceptT CompileError (ModuleT Symbols IO))
  a
-> Compile a
forall a.
RWST
  CompileReader
  CompileWriter
  CompileState
  (ExceptT CompileError (ModuleT (ModuleInfo Compile) IO))
  a
-> Compile a
Compile (RWST
   CompileReader
   CompileWriter
   CompileState
   (ExceptT CompileError (ModuleT Symbols IO))
   a
 -> Compile a)
-> (ModuleT Symbols IO a
    -> RWST
         CompileReader
         CompileWriter
         CompileState
         (ExceptT CompileError (ModuleT Symbols IO))
         a)
-> ModuleT Symbols IO a
-> Compile a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT CompileError (ModuleT Symbols IO) a
-> RWST
     CompileReader
     CompileWriter
     CompileState
     (ExceptT CompileError (ModuleT Symbols IO))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT CompileError (ModuleT Symbols IO) a
 -> RWST
      CompileReader
      CompileWriter
      CompileState
      (ExceptT CompileError (ModuleT Symbols IO))
      a)
-> (ModuleT Symbols IO a
    -> ExceptT CompileError (ModuleT Symbols IO) a)
-> ModuleT Symbols IO a
-> RWST
     CompileReader
     CompileWriter
     CompileState
     (ExceptT CompileError (ModuleT Symbols IO))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleT Symbols IO a -> ExceptT CompileError (ModuleT Symbols IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | The JavaScript FFI interfacing monad.
newtype Fay a = Fay (Identity a)
  deriving
    ( Functor Fay
a -> Fay a
Functor Fay
-> (forall a. a -> Fay a)
-> (forall a b. Fay (a -> b) -> Fay a -> Fay b)
-> (forall a b c. (a -> b -> c) -> Fay a -> Fay b -> Fay c)
-> (forall a b. Fay a -> Fay b -> Fay b)
-> (forall a b. Fay a -> Fay b -> Fay a)
-> Applicative Fay
Fay a -> Fay b -> Fay b
Fay a -> Fay b -> Fay a
Fay (a -> b) -> Fay a -> Fay b
(a -> b -> c) -> Fay a -> Fay b -> Fay c
forall a. a -> Fay a
forall a b. Fay a -> Fay b -> Fay a
forall a b. Fay a -> Fay b -> Fay b
forall a b. Fay (a -> b) -> Fay a -> Fay b
forall a b c. (a -> b -> c) -> Fay a -> Fay b -> Fay c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Fay a -> Fay b -> Fay a
$c<* :: forall a b. Fay a -> Fay b -> Fay a
*> :: Fay a -> Fay b -> Fay b
$c*> :: forall a b. Fay a -> Fay b -> Fay b
liftA2 :: (a -> b -> c) -> Fay a -> Fay b -> Fay c
$cliftA2 :: forall a b c. (a -> b -> c) -> Fay a -> Fay b -> Fay c
<*> :: Fay (a -> b) -> Fay a -> Fay b
$c<*> :: forall a b. Fay (a -> b) -> Fay a -> Fay b
pure :: a -> Fay a
$cpure :: forall a. a -> Fay a
$cp1Applicative :: Functor Fay
Applicative
    , a -> Fay b -> Fay a
(a -> b) -> Fay a -> Fay b
(forall a b. (a -> b) -> Fay a -> Fay b)
-> (forall a b. a -> Fay b -> Fay a) -> Functor Fay
forall a b. a -> Fay b -> Fay a
forall a b. (a -> b) -> Fay a -> Fay b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Fay b -> Fay a
$c<$ :: forall a b. a -> Fay b -> Fay a
fmap :: (a -> b) -> Fay a -> Fay b
$cfmap :: forall a b. (a -> b) -> Fay a -> Fay b
Functor
    , Applicative Fay
a -> Fay a
Applicative Fay
-> (forall a b. Fay a -> (a -> Fay b) -> Fay b)
-> (forall a b. Fay a -> Fay b -> Fay b)
-> (forall a. a -> Fay a)
-> Monad Fay
Fay a -> (a -> Fay b) -> Fay b
Fay a -> Fay b -> Fay b
forall a. a -> Fay a
forall a b. Fay a -> Fay b -> Fay b
forall a b. Fay a -> (a -> Fay b) -> Fay b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Fay a
$creturn :: forall a. a -> Fay a
>> :: Fay a -> Fay b -> Fay b
$c>> :: forall a b. Fay a -> Fay b -> Fay b
>>= :: Fay a -> (a -> Fay b) -> Fay b
$c>>= :: forall a b. Fay a -> (a -> Fay b) -> Fay b
$cp1Monad :: Applicative Fay
Monad
    )