MFlow-0.4.5.2: Demos/AcidState.hs

-- Modified From: https://github.com/acid-state/acid-state/blob/master/examples/HelloDatabase.hs
-- Aistis Raulinaitis
{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TemplateHaskell #-}
{-# OPTIONS -XCPP #-}
module AcidState (
acidState
) where

--import Data.Acid

import Control.Monad.State                   ( get, put )
import Control.Monad.Reader                  ( ask )
import Data.SafeCopy

-- #define ALONE

#ifdef ALONE
import MFlow.Wai.Blaze.Html.All

main = do
--  db <- initAcid
  runNavigation "" . step $ acidState db

#else

import MFlow.Wai.Blaze.Html.All hiding(page)
import Menu  hiding (Database)

#endif


--
--type Message = String
--data Database = Database [Message]



--initAcid= openLocalStateFrom "dist/db/" (Database [])
--
--addMessage :: Message -> Update Database ()
--addMessage msg = do
--  Database messages <- get
--  put $ Database (msg:messages)
--
--viewMessages :: Int -> Query Database [Message]
--viewMessages limit = do
--  Database messages <- Control.Monad.Reader.ask
--  return $ take limit messages
--
-- $(deriveSafeCopy 0 'Data.SafeCopy.base ''Database)
-- $(makeAcidic ''Database ['addMessage, 'viewMessages])
--
--
--getLast10 :: AcidState (EventState AddMessage) -> IO String
--getLast10 database = do
--  messages <- query database (ViewMessages 10)
--  return $ concat [ message ++ "  " | message <- messages ]
--
--addMsg :: AcidState (EventState AddMessage) -> Message -> IO ()
--addMsg database msg = update database (AddMessage msg)
--
--
--
--
acidState db= do
    page $ wlink () << p << "disabled for compatibility with stackage. uncomment it to run it"
--    r <- page $ h3 << "Persistent message demo "
--          ++> getString Nothing
--          <** submitButton "OK"

--
--  liftIO $ addMsg db r
--
--  last10 <- liftIO $ getLast10 db
--
--  page $ b
--    << ("You typed: "++ r ++ ", it has been added to the acid state db.")
--    ++> p << ("Here are the last 10 things in the db: " ++ last10)
--    ++> wlink () << p << "next"
--  acidState db