{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving,
    TypeSynonymInstances, QuasiQuotes #-}
{-# OPTIONS_GHC -F -pgmFtrhsx -fno-warn-orphans #-}
import Control.Applicative ((<$>), optional)
import Control.Monad       (msum)
import Control.Monad.State (StateT, evalStateT)
import Control.Monad.Trans (liftIO)
import qualified Data.Map  as Map
import Data.Maybe          (fromMaybe)
import Happstack.Server    (Response, ServerPartT, dir, mapServerPartT, look, nullConf,
                            ok, simpleHTTP, toResponse)
import Happstack.Server.HSP.HTML  (defaultTemplate) -- ^ also imports 'ToMessage XML'
import Happstack.Server.JMacro    (jmResponse)      -- ^ ToMessage instance for JStat
import HSP                        ( Attr(..), EmbedAsAttr(..), EmbedAsChild(..)
                                  , genElement, genEElement
                                  )
import HSP.ServerPartT            () -- ^ instance 'XMLGenerator ServerPartT'
import HSX.JMacro                 ( IntegerSupply(..)
                                  , nextInteger') -- EmbedAsChild & EmbedAsAttr for JStat
import Language.Javascript.JMacro ( ToJExpr(..), Ident(..), JStat(..), JExpr(..)
                                  , JVal(..), jmacro, jsv, jLam, jVarTy)
import System.Random              (Random(..))

type JMacroPart = ServerPartT (StateT Integer IO)

instance IntegerSupply JMacroPart where
    nextInteger = nextInteger'

main :: IO ()
main = simpleHTTP nullConf $ flatten handlers
    where
      flatten :: JMacroPart a -> ServerPartT IO a
      flatten = mapServerPartT (flip evalStateT 0)

helloJMacro :: JMacroPart Response
helloJMacro =
    toResponse <$> defaultTemplate "Hello JMacro" ()
      <div>
       <% [$jmacro|
           var helloNode = document.createElement('h1');
           helloNode.appendChild(document.createTextNode("Hello, JMacro!"));
           document.body.appendChild(helloNode);
           |] %>
      </div>

helloAttr :: JMacroPart Response
helloAttr =
 toResponse <$> defaultTemplate "Hello Attr" ()
 <h1 style="cursor:pointer" onclick=[$jmacro| alert("that </tickles>!") |]>Click me!</h1>

helloEndTag :: JMacroPart Response
helloEndTag =
    toResponse <$> defaultTemplate "Hello End Tag" ()
    <%>
     <h1>Tricky End Tag</h1>
     <% [$jmacro| alert("this </script> won't mess things up!") |] %>
    </%>

clickMe :: JStat
clickMe =
    [$jmacro|

    var clickNode = document.createElement('p');
    clickNode.appendChild(document.createTextNode("Click me!"));
    document.body.appendChild(clickNode);
    var clickCnt = 0;
    clickNode.setAttribute('style', 'cursor: pointer');
    clickNode.onclick = function () { clickCnt++;
                                      alert ('Been clicked ' + clickCnt + ' time(s).');
                                    };
    |]

clickPart :: JMacroPart Response
clickPart =
    toResponse <$> defaultTemplate "Hygienic Naming" ()
                   <div>
                    <h1>A Demo of Happstack+HSP+JMacro</h1>
                    <% clickMe %>
                    <% clickMe %>
                   </div>

clickMe2Init :: JStat
clickMe2Init =
    [$jmacro| var !clickCnt = 0; |];

clickMe2 :: JStat
clickMe2 =
    [$jmacro|

    var clickNode = document.createElement('p');
    clickNode.appendChild(document.createTextNode("Click me!"));
    document.body.appendChild(clickNode);
    clickNode.setAttribute("style", "cursor: pointer");
    clickNode.onclick = function () { clickCnt++;
                                      alert ('Been clicked ' + clickCnt + ' time(s).');
                                    };
    |]

clickPart2 :: JMacroPart Response
clickPart2 =
    toResponse <$> defaultTemplate "Hygienic Naming"
                   <% clickMe2Init %>
                   <div>
                    <h1>A Demo of Happstack+HSP+JMacro</h1>
                    <% clickMe2 %>
                    <% clickMe2 %>
                   </div>

functionNames :: JMacroPart Response
functionNames =
    toResponse <$> defaultTemplate "Function Names"
          <% [$jmacro|
               function !hello(noun) { alert('hello, ' + noun); }
               var !helloAgain = \noun ->alert('hello again, ' + noun);
               fun goodbye noun { alert('goodbye ' + noun); }
               fun goodbyeAgain noun -> alert('goodbye again, ' + noun);
             |]
           %>
          <%>
            <button onclick=[$jmacro| hello('world'); |]>hello</button>
            <button onclick=[$jmacro| helloAgain('world'); |]>helloAgain</button>
            <button onclick=[$jmacro| goodbye('world'); |]>goodbye</button>
            <button onclick=[$jmacro| goodbyeAgain('world'); |]>goodbyeAgain</button>
          </%>

fortunePart :: JMacroPart Response
fortunePart =
    do let fortunes =
            ["You will be cursed to write Java for the rest of your days."
            , "Fortune smiles upon you, your future will be filled with lambdas"
            ]
       n <- liftIO $ randomRIO (0, (length fortunes) - 1)

       toResponse <$> defaultTemplate "Fortune"
              <% [$jmacro|
                  fun revealFortune fortune
                  {
                   var b = document.getElementById("button");
                   b.setAttribute('disabled', 'disabled');
                   var p = document.getElementById("fortune");
                   p.appendChild(document.createTextNode(fortune));
                  }
                 |]
                  %>
             <div>
              <h1>Your Fortune</h1>
              <p id="fortune"></p>
              <button id="button" onclick=[$jmacro| revealFortune(`(fortunes !! n)`); |]>
                Click to reveal your fortune
              </button>
             </div>

data Skies = Cloudy | Clear
           deriving (Bounded, Enum, Eq, Ord, Read, Show)

newtype Fahrenheit = Fahrenheit Double
           deriving (Num, Enum, Eq, Ord, Read, Show, ToJExpr, Random)

data Weather = Weather
    { skies :: Skies
    , temp  :: Fahrenheit
    }
    deriving (Eq, Ord, Read, Show)

instance Random Skies where
    randomR (lo, hi) g =
       case randomR (fromEnum lo, fromEnum hi) g of
         (c, g') -> (toEnum c, g')
    random g = randomR (minBound, maxBound) g

instance Random Weather where
    randomR (Weather skiesLo tempLo, Weather skiesHi tempHi) g =
        let (skies, g') = randomR (skiesLo, skiesHi) g
            (temp, g'') = randomR (tempLo, tempHi) g'
        in ((Weather skies temp), g'')
    random g =
        let (skies, g') = random g
            (temp, g'') = random g'
        in ((Weather skies temp), g'')

instance ToJExpr Skies where
    toJExpr = toJExpr . show

instance ToJExpr Weather where
   toJExpr (Weather skies temp) =
       toJExpr (Map.fromList [ ("skies", toJExpr skies)
                             , ("temp",  toJExpr temp)
                             ])

weatherPart :: JMacroPart Response
weatherPart =
    do weather <- liftIO $ randomRIO ((Weather minBound (-40)), (Weather maxBound 100))
       toResponse <$> defaultTemplate "Weather Report" ()
        <div>
         <% [$jmacro|
             var w = `(weather)`;
             var p = document.createElement('p');
             p.appendChild(document.createTextNode("The skies will be " + w.skies +
                                                   " and the temperature will be " +
                                                   w.temp.toFixed(1) + "°F"));
             document.body.appendChild(p);
             |] %>
        </div>

externalJs :: String -> JStat
externalJs greeting =
    [$jmacro|
     window.greet = function (noun)
     {
       alert(`(greeting)` + ' ' + noun);
     }
     |]

externalPart :: JMacroPart Response
externalPart = dir "external" $ msum [
            dir "script.js" $
               do greeting <- optional $ look "greeting"
                  ok $ toResponse $ externalJs (fromMaybe "hello" greeting)
         , toResponse <$> defaultTemplate "external"
            <script type="text/javascript" src="/external/script.js?greeting=Ahoy" />
            <div>
             <h1>Greetings</h1>
             <button onclick=[$jmacro| greet('JMacro'); |]>Click for a greeting.</button>
            </div>
         ]

externalJs2 :: String -> JStat
externalJs2 greeting =
    [$jmacro|
     function !greet2 (noun)
     {
       alert(`(greeting)` + ' ' + noun);
     }
     |]


externalPart2 :: JMacroPart Response
externalPart2 = dir "external2" $ msum
    [ dir "script.js" $
          do greeting <- optional $ look "greeting"
             jmResponse $ externalJs2 (fromMaybe "hello" greeting)

    , toResponse <$> defaultTemplate "external 2"
       <script type="text/javascript" src="/external2/script.js?greeting=Ahoy" />
       <div>
        <h1>Greetings</h1>
        <button onclick=[$jmacro| greet2('JMacro'); |]>Click for a greeting.</button>
       </div>
    ]

demosPart :: JMacroPart Response
demosPart =
    toResponse <$> defaultTemplate "demos" ()
                   <ul>
                    <li><a href="/hello"    >Hello, JMacro</a></li>
                    <li><a href="/attr"     >Hello, Attr</a></li>
                    <li><a href="/endTag"   >Hello, End Tag</a></li>
                    <li><a href="/clickMe"  >ClickMe</a></li>
                    <li><a href="/clickMe2" >ClickMe2</a></li>
                    <li><a href="/functions">Function Names</a></li>
                    <li><a href="/fortune"  >Fortune</a></li>
                    <li><a href="/weather"  >Weather</a></li>
                    <li><a href="/external" >External</a></li>
                    <li><a href="/external2" >External 2</a></li>
                   </ul>

handlers :: JMacroPart Response
handlers =
   msum [ dir "hello"     $ helloJMacro
        , dir "attr"      $ helloAttr
        , dir "endTag"    $ helloEndTag
        , dir "clickMe"   $ clickPart
        , dir "clickMe2"  $ clickPart2
        , dir "functions" $ functionNames
        , dir "fortune"   $ fortunePart
        , dir "weather"   $ weatherPart
        , externalPart
        , externalPart2
        , demosPart
        ]

