Page.hs

-- | This file is part of AdrianParvin.
-- |
-- | AdrianParvin is free software: you can redistribute it and/or modify
-- | it under the terms of the GNU General Public License as published by
-- | the Free Software Foundation, either version 3 of the License, or
-- | (at your option) any later version.
-- |
-- | AdrianParvin is distributed in the hope that it will be useful,
-- | but WITHOUT ANY WARRANTY; without even the implied warranty of
-- | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- | GNU General Public License for more details.
-- |
-- | You should have received a copy of the GNU General Public License
-- | along with AdrianParvin.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}

module AdrianParvin.Client.Page where

import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Data.Maybe

import qualified Data.Map as Map
import           Data.Semigroup ((<>))
import qualified Data.Text as T
import qualified Data.Text.IO as T

import           Reflex.Dom
import           Reflex.HTML
import           GHCJS.DOM.Types hiding (Event)

type PrerenderClientConstraint js m =
  ( HasJS js m
  , HasJS js (Performable m)
  , MonadJSM m
  , MonadJSM (Performable m)
  , HasJSContext m
  , HasJSContext (Performable m)
  , MonadFix m
  , MonadFix (Performable m)
  )
page :: forall js t m. ( MonadHold t m
                       , PostBuild t m
                       , Prerender js m
                       , DomBuilder t m
                       , TriggerEvent t m
                       , PerformEvent t m
                       , MonadIO (Performable m)) => m ()
page = void $ do
  elAttr "table" (Map.singleton "id" "header") $ do
    el "tbody" $ do
      el "tr" $ do
        elAttr "td" (Map.singleton "class" "logo" <> Map.singleton "rowspan" "2") $ text "logo"
        elClass "td" "main" $ text "Adri website"
      el "tr" $ do
        elClass "td" "sub" $ text "For boring Adri stuff"
  let cvFromFile = (fmap $ fmap (body))                                                . performEvent        =<< (fmap $ const $ liftIO $ T.readFile "./static/CV.html") <$> getPostBuild
      cvFromURL :: PrerenderClientConstraint js m => m (Event t (m ()))
      cvFromURL  = (fmap $ fmap (body . fromMaybe mempty . _xhrResponse_responseText)) . performRequestAsync =<< (fmap $ const $ XhrRequest "GET" "/static/CV.html" def) <$> getPostBuild
  runWithReplace (return ()) =<<
    prerender cvFromFile cvFromURL