AppState2.hs

{-#  OPTIONS -fglasgow-exts  #-}
{-#  LANGUAGE TemplateHaskell , FlexibleInstances, UndecidableInstances, OverlappingInstances,
             MultiParamTypeClasses, GeneralizedNewtypeDeriving  #-}
module StateVersions.AppState2 ( InsertPage (..), State(..), AskPages (..), Old.Page (..), Old.Title(..), Old.Body (..) ) 
  where

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

import qualified StateVersions.AppState1 as Old

-- Keep the page
type Page = Old.Page
type Title = Old.Title
type Body = Old.Body 

type Pages = Map.Map String Page
data State  = State  {  pages :: Pages
                     }  deriving (Read, Show, Typeable, Data)


-- Only for the new state
$(deriveSerialize ''State)

instance Migrate Old.State State where
    migrate (Old.State p) = State (Map.fromList p)
    
instance Version State where
    mode = extension 1 (Proxy :: Proxy Old.State)


instance Component State where
    type Dependencies State = End             --  no dependencies
    initialValue = State {pages = Map.empty}  --  no pages

insertPage  :: MonadState State m => String -> Page -> m ()
insertPage pageName page = modPages $ Map.insert 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])