happs-tutorial-0.8: src/migrationexample/StateVersions/AppState1.hs

{-#  OPTIONS -fglasgow-exts  #-}
{-#  LANGUAGE TemplateHaskell , FlexibleInstances, UndecidableInstances, OverlappingInstances,
             MultiParamTypeClasses, GeneralizedNewtypeDeriving  #-}
module StateVersions.AppState1 where

import Happstack.State
import qualified Data.Map as Map
import Data.Generics
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State (modify,put,get,gets,MonadState)

newtype Title = Title String
  deriving (Read,Show,Eq,Data,Typeable)
instance Version Title
$(deriveSerialize ''Title)

newtype Body = Body String
  deriving (Read,Show,Eq,Data,Typeable)
instance Version Body
$(deriveSerialize ''Body)

data Page = Page {  title  :: Title
                 ,  body   :: Body
                 }  deriving (Read, Show, Eq, Typeable, Data)

type Pages = [(String, Page)]

data State  = State  {  pages :: Pages
                     }  deriving (Read, Show, Typeable, Data)

instance Version State
instance Version Page

$(deriveSerialize ''Page)
$(deriveSerialize ''State)

instance Component State where
    type Dependencies State = End      --  no dependencies
    initialValue = State {pages = []}  --  no pages

insertPage :: MonadState State m => String -> Page -> m ()
insertPage pageName page = modPages $ (:) (pageName,page)

modPages :: MonadState State m => (Pages -> Pages) -> m ()
modPages f = modify (\s -> State (f $ pages s))

askPages :: MonadReader State m => m (Pages)
askPages = asks pages

$(mkMethods ''State ['askPages, 'insertPage])