Main.hs

module Main where
import Control.Concurrent (threadDelay)

import Business.Types

import JavaScript.JQuery
import Data.Default

import Prelude hiding (div)
import Blaze.React
import qualified Text.Blaze.Event                     as E
import qualified Text.Blaze.Event.Keycode             as Keycode
import qualified Text.Blaze.Html5                     as H
import qualified Text.Blaze.Html5.Attributes          as A
import qualified Blaze.React.Run.ReactJS          as ReactJS

import qualified Data.Text       as T
import           Control.Lens
                 ( makeLenses, view, traverse, folded, set, ix
                 , to, _2, _Just, sumOf, (%=), (.=), preuse, use
                 )
import           Control.Monad.Trans.Maybe        (MaybeT(..), runMaybeT)
import Control.Monad.IO.Class
import           Control.Monad.Trans.Writer (tell)


import           Data.Foldable   (foldMap)
import           Data.Maybe      (fromMaybe)
import           Data.Monoid     ((<>), mempty)
import           Data.Typeable   (Typeable)
import           Control.Applicative
import Control.Monad



----------------------------------------------------------------
-- State Data Definitions
----------------------------------------------------------------
data MenuItem = MenuItem { _miName :: !T.Text } deriving (Eq, Show)

-- | What item is being edited and together with the new text value that it
-- should have.
type EditFocus = Maybe (Int, T.Text)

data MealPlanState = MealPlanState
    { _mpsNewItemDesc :: !T.Text
    , _mpsEditFocus   :: !EditFocus
    , _mpsCount       :: !T.Text
    , _mpsItems       :: ![MenuItem]
    } deriving (Eq, Show)

makeLenses ''MenuItem
makeLenses ''MealPlanState

-- | Serializable representations of state transitions possible for our todo
-- item management app.
data MealPlanAction
    = CreateItemA
    | UpdateNewItemDescA T.Text
    | CountUpdateA       T.Text
    | NullActionA
    deriving (Eq, Ord, Show, Read, Typeable)

----------------------------------------------------------------
-- State Updating
----------------------------------------------------------------
consoleLog :: T.Text -> [IO MealPlanAction]
consoleLog msg = [ print msg >> return NullActionA ]

ajaxCount :: [IO MealPlanAction]
ajaxCount = [ do
                result <- ajax "counter" [] (def { asMethod = POST })
                print "Got result:"
                print $ arStatus result
                print $ arData   result
                case arData result of
                  Just resultData -> return $ CountUpdateA resultData
                  Nothing         -> return NullActionA
            ]

applyAction :: MealPlanAction -> Transition MealPlanState MealPlanAction
applyAction action =
    runTransitionM $ case action of
      CreateItemA -> do
        tell $ consoleLog "OMG2"
        tell $ ajaxCount

        newItemDesc <- use mpsNewItemDesc
        unless (T.null newItemDesc) $ do
            let newItem = MenuItem newItemDesc
            mpsItems       %= (newItem :)
            mpsNewItemDesc .= ""
      UpdateNewItemDescA newText -> mpsNewItemDesc .= newText
      CountUpdateA newCount -> mpsCount .= newCount
      NullActionA -> return ()

----------------------------------------------------------------
-- Rendering
----------------------------------------------------------------

renderMealPlanState :: MealPlanState -> WindowState MealPlanAction
renderMealPlanState state = WindowState
    { _wsBody = renderBody state
    , _wsPath = ""
    }

renderBody :: MealPlanState -> H.Html MealPlanAction
renderBody (MealPlanState newItemDesc _ count items) = do
  H.div $ do
    H.h1 $ do
      H.toHtml ("Plan your Meals:" :: T.Text)
      H.toHtml count
    H.input H.! A.id "new-menu-item"
            H.! A.placeholder "What're you Eating?"
            H.! A.autofocus True
            H.! A.value (H.toValue newItemDesc)
            H.! E.onValueChange UpdateNewItemDescA
            H.! E.onKeyDown [Keycode.enter] CreateItemA

  unless (null items) $ do
    H.section H.! A.id "main" $ do
      H.ul H.! A.id "menu-item-list" $
        foldMap renderMenuItem (zip [0..] items)

renderMenuItem :: (Int, MenuItem) -> H.Html MealPlanAction
renderMenuItem (index, item) =
  H.li $ do
    H.toHtml $ _miName item
    H.toHtml $ index

----------------------------------------------------------------
-- Main Entry Point
----------------------------------------------------------------

main :: IO ()
main = ReactJS.runApp $ ignoreWindowActions app

app :: App MealPlanState MealPlanAction
app = App
    { appInitialState    = initialState
    , appInitialRequests = []
    , appApplyAction     = applyAction
    , appRender          = renderMealPlanState
    }

initialState :: MealPlanState
initialState = MealPlanState
    { _mpsNewItemDesc = ""
    , _mpsCount = "0"
    , _mpsEditFocus   = Nothing
    , _mpsItems       = []
    }