Acid.hs

{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards #-}
module Clckwrks.Menu.Acid
    where

import Clckwrks.Menu.Types
import Control.Applicative ((<$>))
import Control.Monad.Reader (ask)
import Control.Monad.State (get, put)
import Control.Monad.Trans (liftIO)
import Data.Acid (AcidState, Query, Update, makeAcidic)
import Data.Data (Data, Typeable)
import Data.IxSet (Indexable, IxSet, (@=), empty, fromList, getOne, ixSet, ixFun, insert, toList, updateIx)
import Data.SafeCopy
import Data.Text (Text)
import Data.Tree (Tree(..))
import qualified Data.Text as Text


data MenuState url  = MenuState 
    { menu      :: Menu url
    }
    deriving (Eq, Read, Show, Data, Typeable)
$(deriveSafeCopy 1 'base ''MenuState)

initialMenuState :: MenuState url
initialMenuState = MenuState { menu = Menu [] }

askMenu :: Query (MenuState url) (Menu url)
askMenu =
    do MenuState{..} <- ask
       return menu

addItem :: MenuItem url -> Update (MenuState url) (Menu url)
addItem item =
    do ms@MenuState{..} <- get
       let menu' = Menu $ (menuItems menu) ++ [Node item []]
       put $ ms { menu = menu' }
       return menu'

setMenu :: Menu url -> Update (MenuState url) ()
setMenu newMenu =
    do ms <- get
       put $ ms { menu = newMenu }

$(makeAcidic ''MenuState ['askMenu, 'addItem, 'setMenu])