AppState3.hs

{-#  OPTIONS -fglasgow-exts  #-}
{-#  LANGUAGE TemplateHaskell , FlexibleInstances, UndecidableInstances, OverlappingInstances,
             MultiParamTypeClasses, GeneralizedNewtypeDeriving  #-}
module StateVersions.AppState3 ( InsertPage (..), State, AskPages (..), Page (..), Old.Title(..), Old.Body (..),
  Header (..)
) 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.AppState2 as Old

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

type Title = Old.Title
type Body = Old.Body 


-- Keep the page
data Page = Page Title Header Body 
  deriving (Read,Show,Eq,Data,Typeable)

-- should this version somehow extend the version from State2?
instance Version Page
$(deriveSerialize ''Page)


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.map migratepage p)
    
migratepage (Old.Page t b) = Page t (Header "") b 

instance Version State where
    mode = extension 2 (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])