------------------------------------------------------------------
-- |
-- Module      :  Language.JSMW.Monad
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- A special monad: the core of the Writer.
------------------------------------------------------------------

module Language.JSMW.Monad (
  JContainer
 ,nullContainer
 -- * The Monad itself
 ,JSMW 
 ,runJSMWWith
 ,getBlock
 ,nestBlock
 -- * Compilation control
 ,once
 ,copy
 ,mkNewVar
 ,writeStmt
 -- * Create Javascript values, Monadic versions
 ,stringM
 ,numberM
 ,boolM
  ) where

import Data.List
import Language.JSMW.Type
import Control.Monad
import Control.Monad.State
import Control.Monad.RWS
import BrownPLT.JavaScript
import BrownPLT.JavaScript.PrettyPrint

-- | A class to serve as a general container for JSMW monad elements.

class JContainer a

-- | A null-container to use JSMW without container features.

instance JContainer ()

nullContainer :: Expression ()

nullContainer = NullLit ()

-- | A type of the writer: based on the 'RWS' Monad. The Reader part holds an expression
-- to reference the curent HTML container element. The Writer part is the list of Javascript
-- statements being formed. Container may be any DOM Element, but not a Text node 
-- or anything else. /e/ is type of the container, /a/ is type of the statements emitted,
-- /x/ is type of the returned value.

type JSMW e a x = RWS (Expression e) [Statement a] Int x

-- | Run the code writer (raw way, returns both state and log) with explicitly
-- specified container.

runJSMWWith :: (JContainer e)
            => (Expression e)                         -- ^ container
            -> Int                                    -- ^ Initial state (usually 0)
            -> JSMW e b (Expression a)                -- ^ The JSMW expression to process
            -> (Expression a, Int, [Statement b])     -- ^ Result: (final expression, 
                                                      --   final state,
                                                      --   produced statements),
runJSMWWith e st q = runRWS q e st

-- | Obtain a block statement from the result of 'runJSWM'. The last expression
-- forms a \'return\' statement, so the resulting block may be used as a function\'s body.

getBlock :: (Expression a, Int, [Statement b]) -> Statement a

getBLock (NullLit ft, _, stmts) = BlockStmt (undefined :: a) stmts
getBlock (fin, _, stmts) = 
  let ft = exprType fin
  in  BlockStmt ft (map (/\ ft) stmts ++ [ReturnStmt ft (Just fin)])


-- | Create a nested block. Basically combination of 'getBlock' and 'runJSMWWith'.
-- State of the current writer will be updated accordingly.

nestBlock :: (JContainer ec, JContainer ei)
          => (Expression ei)                          -- ^ nested container
          -> JSMW ei y (Expression x)                 -- ^ contents of the nested block
          -> JSMW ec a (Statement x)                  -- ^ resulting block statement

nestBlock e q = do
  st <- get
  let (finx, fins, stms) = runJSMWWith e st q
      blk = getBlock (finx, fins, stms)
      ta = undefined :: a
  put fins
  return (blk /\ ta)

-- | Create a unique variable name. This function increments the internal state of the
-- monad and produces a string consisting of the letter \'v\' and a unique number.

mkNewVar :: JSMW e s String

mkNewVar = do
  modify (+ 1)
  n <- get
  return ('v' : show n)
  
-- | Write out a statement. This function utilizes the Writer part of the monad, and
-- adds the Javascript statement provided to the Writer's log.

writeStmt :: Statement a -> JSMW e a (Expression a)

writeStmt s = tell [s] >> (return $ NullLit (undefined :: a))

-- | Register usage of a function with the script builder. Only 'FunctionStmt' is allowed
-- to pass, and the function name is altered to be impossible in Javascript: thus the builder
-- will recognize them. The modified 'FunctionStmt' is written into the statements stream.
-- Anything else is just ignored. This function is usually invoked by prologues auto-generated
-- by the JSMW preprocessor, and is not expected to be called from developer's code.

__use :: Statement a -> JSMW e a (Expression a)

__use (FunctionStmt t1 (Id t2 fn) ps fb) = writeStmt $ FunctionStmt t1 (Id t2 ("@#!" ++ fn)) ps fb

__use s = return $ NullLit (undefined :: a)

-- | The JSMW code consists of monadic smart constructors forming Javascript
-- method calls. These constructors are inlined each time they are referenced.
-- The "once" combinator causes a variable assignment statement to be formed
-- with the variable assigned to the expression returned. All future references
-- will be to the variable rather than to the expression. Since the expression
-- will be evaluated when assigned to the variable, referencing the variable
-- will reference the result, and possible effect will not be repeated.

once :: Expression a -> JSMW e s (Expression a)

once e@(VarRef _ _) = return e

once e = copy e

-- | Same as 'once', but even a variable reference will be copied into another
-- variable.

copy :: Expression a -> JSMW e s (Expression a)

copy e = do
  nv <- mkNewVar
  let et = exprType e
      es = undefined :: s
      eo = e /\ es
      stm = VarDeclStmt es [VarDecl es (Id es nv) (Just eo)]
      vr = VarRef et (Id et nv)
  writeStmt stm
  return vr

-- | Create a Javascript string literal out of a string, monadic version.

stringM :: String -> JSMW e s (Expression String)

stringM s = once =<< (return $ string s)

-- | Create a Javascript numeric literal out of a numeric value, monadic version.

numberM :: (Integral n) => n -> JSMW e s (Expression Double)

numberM = return . number

-- | Create a Javascript boolean literal out of a Boolean, monadic version.

boolM :: Bool -> JSMW e s (Expression Bool)

boolM = return . bool