Main.hs

module Main where

import Business.Types

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.Trans (liftIO)

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
----------------------------------------------------------------
type MenuItem = T.Text

-- | 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
    , _mpsItems       :: ![MenuItem]
    } deriving (Eq, Show)

makeLenses ''MealPlanState

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

----------------------------------------------------------------
-- State Updating
----------------------------------------------------------------

applyAction :: MealPlanAction -> Transition MealPlanState MealPlanAction
applyAction action =
    runTransitionM $ case action of
      CreateItemA -> do
          liftIO $ putStrLn "Added an item..."
          newItemDesc <- use mpsNewItemDesc
          unless (T.null newItemDesc) $ do
              mpsItems       %= (newItemDesc :)
              mpsNewItemDesc .= ""
      UpdateNewItemDescA newText -> mpsNewItemDesc .= newText

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

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

renderBody :: MealPlanState -> H.Html MealPlanAction
renderBody (MealPlanState newItemDesc _ items) = do
  H.div $ do
    H.h1 "Anything"
    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 items

renderMenuItem :: MenuItem -> H.Html MealPlanAction
renderMenuItem item = H.li $ H.toHtml item

----------------------------------------------------------------
-- 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 = ""
    , _mpsEditFocus   = Nothing
    , _mpsItems       = []
    }