{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards, OverloadedStrings, QuasiQuotes #-}
module Clckwrks.Page.Acid
    ( module Clckwrks.Page.Types
      -- * state
    , PageState
    , initialPageState
      -- * events
    , NewPage(..)
    , PageById(..)
    , GetPageTitle(..)
    , IsPublishedPage(..)
    , PagesSummary(..)
    , UpdatePage(..)
    , AllPosts(..)
    , AllPublishedPages(..)
    , GetFeedConfig(..)
    , SetFeedConfig(..)
    , GetBlogTitle(..)
    , GetOldUACCT(..)
    , ClearOldUACCT(..)
    ) where

import Clckwrks             (UserId(..))
import Clckwrks.Page.Types  (Markup(..), PublishStatus(..), PreProcessor(..), PageId(..), PageKind(..), Page(..), Pages(..), FeedConfig(..), Slug(..), initialFeedConfig, slugify)
import Clckwrks.Page.Verbatim (verbatimText)
import Clckwrks.Types       (Trust(..))
import Clckwrks.Monad       (ThemeStyleId(..))
import Control.Applicative  ((<$>))
import Control.Monad.Reader (ask)
import Control.Monad.State  (get, modify, put)
import Control.Monad.Trans  (liftIO)
import Data.Acid            (AcidState, Query, Update, makeAcidic)
import Data.Data            (Data, Typeable)
import Data.IxSet           (Indexable, IxSet, (@=), Proxy(..), empty, fromList, getOne, ixSet, ixFun, insert, toList, toDescList, updateIx)
import Data.Maybe           (fromJust)
import Data.SafeCopy        (Migrate(..), base, deriveSafeCopy, extension)
import Data.String          (fromString)
import Data.Text            (Text)
import Data.Time.Clock      (UTCTime, getCurrentTime)
import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
import qualified Data.Text  as Text
import           Data.UUID  (UUID)
import qualified Data.UUID  as UUID
import HSP.Google.Analytics (UACCT)

data PageState_001  = PageState_001
    { PageState_001 -> PageId
nextPageId_001 :: PageId
    , PageState_001 -> IxSet Page
pages_001      :: IxSet Page
    }
    deriving (PageState_001 -> PageState_001 -> Bool
(PageState_001 -> PageState_001 -> Bool)
-> (PageState_001 -> PageState_001 -> Bool) -> Eq PageState_001
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageState_001 -> PageState_001 -> Bool
$c/= :: PageState_001 -> PageState_001 -> Bool
== :: PageState_001 -> PageState_001 -> Bool
$c== :: PageState_001 -> PageState_001 -> Bool
Eq, ReadPrec [PageState_001]
ReadPrec PageState_001
Int -> ReadS PageState_001
ReadS [PageState_001]
(Int -> ReadS PageState_001)
-> ReadS [PageState_001]
-> ReadPrec PageState_001
-> ReadPrec [PageState_001]
-> Read PageState_001
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PageState_001]
$creadListPrec :: ReadPrec [PageState_001]
readPrec :: ReadPrec PageState_001
$creadPrec :: ReadPrec PageState_001
readList :: ReadS [PageState_001]
$creadList :: ReadS [PageState_001]
readsPrec :: Int -> ReadS PageState_001
$creadsPrec :: Int -> ReadS PageState_001
Read, Int -> PageState_001 -> ShowS
[PageState_001] -> ShowS
PageState_001 -> String
(Int -> PageState_001 -> ShowS)
-> (PageState_001 -> String)
-> ([PageState_001] -> ShowS)
-> Show PageState_001
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageState_001] -> ShowS
$cshowList :: [PageState_001] -> ShowS
show :: PageState_001 -> String
$cshow :: PageState_001 -> String
showsPrec :: Int -> PageState_001 -> ShowS
$cshowsPrec :: Int -> PageState_001 -> ShowS
Show, Typeable PageState_001
DataType
Constr
Typeable PageState_001
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PageState_001 -> c PageState_001)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PageState_001)
-> (PageState_001 -> Constr)
-> (PageState_001 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PageState_001))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PageState_001))
-> ((forall b. Data b => b -> b) -> PageState_001 -> PageState_001)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PageState_001 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PageState_001 -> r)
-> (forall u. (forall d. Data d => d -> u) -> PageState_001 -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PageState_001 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001)
-> Data PageState_001
PageState_001 -> DataType
PageState_001 -> Constr
(forall b. Data b => b -> b) -> PageState_001 -> PageState_001
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_001 -> c PageState_001
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_001
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PageState_001 -> u
forall u. (forall d. Data d => d -> u) -> PageState_001 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_001 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_001 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_001
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_001 -> c PageState_001
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PageState_001)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PageState_001)
$cPageState_001 :: Constr
$tPageState_001 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
gmapMp :: (forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
gmapM :: (forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PageState_001 -> m PageState_001
gmapQi :: Int -> (forall d. Data d => d -> u) -> PageState_001 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PageState_001 -> u
gmapQ :: (forall d. Data d => d -> u) -> PageState_001 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PageState_001 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_001 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_001 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_001 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_001 -> r
gmapT :: (forall b. Data b => b -> b) -> PageState_001 -> PageState_001
$cgmapT :: (forall b. Data b => b -> b) -> PageState_001 -> PageState_001
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PageState_001)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PageState_001)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PageState_001)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PageState_001)
dataTypeOf :: PageState_001 -> DataType
$cdataTypeOf :: PageState_001 -> DataType
toConstr :: PageState_001 -> Constr
$ctoConstr :: PageState_001 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_001
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_001
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_001 -> c PageState_001
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_001 -> c PageState_001
$cp1Data :: Typeable PageState_001
Data, Typeable)
$(deriveSafeCopy 1 'base ''PageState_001)

data PageState_002  = PageState_002
    { PageState_002 -> PageId
nextPageId_002 :: PageId
    , PageState_002 -> IxSet Page
pages_002      :: IxSet Page
    , PageState_002 -> FeedConfig
feedConfig_002 :: FeedConfig
    }
    deriving (PageState_002 -> PageState_002 -> Bool
(PageState_002 -> PageState_002 -> Bool)
-> (PageState_002 -> PageState_002 -> Bool) -> Eq PageState_002
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageState_002 -> PageState_002 -> Bool
$c/= :: PageState_002 -> PageState_002 -> Bool
== :: PageState_002 -> PageState_002 -> Bool
$c== :: PageState_002 -> PageState_002 -> Bool
Eq, ReadPrec [PageState_002]
ReadPrec PageState_002
Int -> ReadS PageState_002
ReadS [PageState_002]
(Int -> ReadS PageState_002)
-> ReadS [PageState_002]
-> ReadPrec PageState_002
-> ReadPrec [PageState_002]
-> Read PageState_002
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PageState_002]
$creadListPrec :: ReadPrec [PageState_002]
readPrec :: ReadPrec PageState_002
$creadPrec :: ReadPrec PageState_002
readList :: ReadS [PageState_002]
$creadList :: ReadS [PageState_002]
readsPrec :: Int -> ReadS PageState_002
$creadsPrec :: Int -> ReadS PageState_002
Read, Int -> PageState_002 -> ShowS
[PageState_002] -> ShowS
PageState_002 -> String
(Int -> PageState_002 -> ShowS)
-> (PageState_002 -> String)
-> ([PageState_002] -> ShowS)
-> Show PageState_002
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageState_002] -> ShowS
$cshowList :: [PageState_002] -> ShowS
show :: PageState_002 -> String
$cshow :: PageState_002 -> String
showsPrec :: Int -> PageState_002 -> ShowS
$cshowsPrec :: Int -> PageState_002 -> ShowS
Show, Typeable PageState_002
DataType
Constr
Typeable PageState_002
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PageState_002 -> c PageState_002)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PageState_002)
-> (PageState_002 -> Constr)
-> (PageState_002 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PageState_002))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PageState_002))
-> ((forall b. Data b => b -> b) -> PageState_002 -> PageState_002)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PageState_002 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PageState_002 -> r)
-> (forall u. (forall d. Data d => d -> u) -> PageState_002 -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PageState_002 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002)
-> Data PageState_002
PageState_002 -> DataType
PageState_002 -> Constr
(forall b. Data b => b -> b) -> PageState_002 -> PageState_002
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_002 -> c PageState_002
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_002
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PageState_002 -> u
forall u. (forall d. Data d => d -> u) -> PageState_002 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_002 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_002 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_002
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_002 -> c PageState_002
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PageState_002)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PageState_002)
$cPageState_002 :: Constr
$tPageState_002 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
gmapMp :: (forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
gmapM :: (forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PageState_002 -> m PageState_002
gmapQi :: Int -> (forall d. Data d => d -> u) -> PageState_002 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PageState_002 -> u
gmapQ :: (forall d. Data d => d -> u) -> PageState_002 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PageState_002 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_002 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_002 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_002 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState_002 -> r
gmapT :: (forall b. Data b => b -> b) -> PageState_002 -> PageState_002
$cgmapT :: (forall b. Data b => b -> b) -> PageState_002 -> PageState_002
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PageState_002)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PageState_002)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PageState_002)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PageState_002)
dataTypeOf :: PageState_002 -> DataType
$cdataTypeOf :: PageState_002 -> DataType
toConstr :: PageState_002 -> Constr
$ctoConstr :: PageState_002 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_002
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState_002
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_002 -> c PageState_002
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState_002 -> c PageState_002
$cp1Data :: Typeable PageState_002
Data, Typeable)
$(deriveSafeCopy 2 'extension ''PageState_002)

instance Migrate PageState_002 where
    type MigrateFrom PageState_002 = PageState_001
    migrate :: MigrateFrom PageState_002 -> PageState_002
migrate (PageState_001 npi pgs) =
        PageId -> IxSet Page -> FeedConfig -> PageState_002
PageState_002 PageId
npi IxSet Page
pgs (FeedConfig :: UUID -> Text -> Text -> Text -> FeedConfig
FeedConfig { feedUUID :: UUID
feedUUID       = Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID) -> Maybe UUID -> UUID
forall a b. (a -> b) -> a -> b
$ String -> Maybe UUID
UUID.fromString String
"fa6cf090-84d7-11e1-8001-0021cc712949"
                                          , feedTitle :: Text
feedTitle      = String -> Text
forall a. IsString a => String -> a
fromString String
"Untitled Feed"
                                          , feedLink :: Text
feedLink       = String -> Text
forall a. IsString a => String -> a
fromString String
""
                                          , feedAuthorName :: Text
feedAuthorName = String -> Text
forall a. IsString a => String -> a
fromString String
"Anonymous"
                                          })

data PageState  = PageState
    { PageState -> PageId
nextPageId :: PageId
    , PageState -> IxSet Page
pages      :: IxSet Page
    , PageState -> FeedConfig
feedConfig :: FeedConfig
    , PageState -> Maybe UACCT
uacct      :: Maybe UACCT
    }
    deriving (PageState -> PageState -> Bool
(PageState -> PageState -> Bool)
-> (PageState -> PageState -> Bool) -> Eq PageState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageState -> PageState -> Bool
$c/= :: PageState -> PageState -> Bool
== :: PageState -> PageState -> Bool
$c== :: PageState -> PageState -> Bool
Eq, ReadPrec [PageState]
ReadPrec PageState
Int -> ReadS PageState
ReadS [PageState]
(Int -> ReadS PageState)
-> ReadS [PageState]
-> ReadPrec PageState
-> ReadPrec [PageState]
-> Read PageState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PageState]
$creadListPrec :: ReadPrec [PageState]
readPrec :: ReadPrec PageState
$creadPrec :: ReadPrec PageState
readList :: ReadS [PageState]
$creadList :: ReadS [PageState]
readsPrec :: Int -> ReadS PageState
$creadsPrec :: Int -> ReadS PageState
Read, Int -> PageState -> ShowS
[PageState] -> ShowS
PageState -> String
(Int -> PageState -> ShowS)
-> (PageState -> String)
-> ([PageState] -> ShowS)
-> Show PageState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageState] -> ShowS
$cshowList :: [PageState] -> ShowS
show :: PageState -> String
$cshow :: PageState -> String
showsPrec :: Int -> PageState -> ShowS
$cshowsPrec :: Int -> PageState -> ShowS
Show, Typeable PageState
DataType
Constr
Typeable PageState
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PageState -> c PageState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PageState)
-> (PageState -> Constr)
-> (PageState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PageState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PageState))
-> ((forall b. Data b => b -> b) -> PageState -> PageState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PageState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PageState -> r)
-> (forall u. (forall d. Data d => d -> u) -> PageState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PageState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PageState -> m PageState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PageState -> m PageState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PageState -> m PageState)
-> Data PageState
PageState -> DataType
PageState -> Constr
(forall b. Data b => b -> b) -> PageState -> PageState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState -> c PageState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PageState -> u
forall u. (forall d. Data d => d -> u) -> PageState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PageState -> m PageState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState -> m PageState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState -> c PageState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PageState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PageState)
$cPageState :: Constr
$tPageState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PageState -> m PageState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState -> m PageState
gmapMp :: (forall d. Data d => d -> m d) -> PageState -> m PageState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PageState -> m PageState
gmapM :: (forall d. Data d => d -> m d) -> PageState -> m PageState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PageState -> m PageState
gmapQi :: Int -> (forall d. Data d => d -> u) -> PageState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PageState -> u
gmapQ :: (forall d. Data d => d -> u) -> PageState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PageState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PageState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PageState -> r
gmapT :: (forall b. Data b => b -> b) -> PageState -> PageState
$cgmapT :: (forall b. Data b => b -> b) -> PageState -> PageState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PageState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PageState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PageState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PageState)
dataTypeOf :: PageState -> DataType
$cdataTypeOf :: PageState -> DataType
toConstr :: PageState -> Constr
$ctoConstr :: PageState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PageState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState -> c PageState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PageState -> c PageState
$cp1Data :: Typeable PageState
Data, Typeable)
$(deriveSafeCopy 3 'extension ''PageState)

instance Migrate PageState where
    type MigrateFrom PageState = PageState_002
    migrate :: MigrateFrom PageState -> PageState
migrate (PageState_002 npi pgs fc) =
        PageId -> IxSet Page -> FeedConfig -> Maybe UACCT -> PageState
PageState PageId
npi IxSet Page
pgs FeedConfig
fc Maybe UACCT
forall a. Maybe a
Nothing

initialPageMarkup :: Text
initialPageMarkup :: Text
initialPageMarkup = [verbatimText|Congratulations! You are now running clckwrks! There are a few more steps you will want to take now.

Create an Account
-----------------

Go [here](/authenticate/login) and create an account for yourself.

Give yourself Administrator permissions
-------------------------------

After you create an account you will want to give yourself `Administrator` privileges. This can be done using the `clckwrks-cli` tool. *While the server is running* invoke `clckwrks-cli` and point it to the socket file:

    $ clckwrks-cli _state/profileData_socket

that should start an interactive session. If the server is running as `root`, then you may need to add a `sudo` in front.

Assuming you are `UserId 1` you can now give yourself admin access:

    % user add-role 1 Administrator

You can run `help` for a list of other commands. Type `quit` to exit.

Explore the Admin console
-------------------------

Now you can explore the [Admin Console](/clck/admin/console).

|]

initialPageState :: IO PageState
initialPageState :: IO PageState
initialPageState =
    do FeedConfig
fc <- IO FeedConfig
initialFeedConfig
       PageState -> IO PageState
forall (m :: * -> *) a. Monad m => a -> m a
return (PageState -> IO PageState) -> PageState -> IO PageState
forall a b. (a -> b) -> a -> b
$ PageState :: PageId -> IxSet Page -> FeedConfig -> Maybe UACCT -> PageState
PageState { nextPageId :: PageId
nextPageId = Integer -> PageId
PageId Integer
2
                          , pages :: IxSet Page
pages = [Page] -> IxSet Page
forall a. (Indexable a, Ord a, Typeable a) => [a] -> IxSet a
fromList [ Page :: PageId
-> UserId
-> Text
-> Maybe Slug
-> Markup
-> Maybe Markup
-> UTCTime
-> UTCTime
-> PublishStatus
-> PageKind
-> UUID
-> ThemeStyleId
-> Page
Page { pageId :: PageId
pageId        = Integer -> PageId
PageId Integer
1
                                                    , pageAuthor :: UserId
pageAuthor    = Integer -> UserId
UserId Integer
1
                                                    , pageTitle :: Text
pageTitle     = Text
"Welcome To clckwrks!"
                                                    , pageSlug :: Maybe Slug
pageSlug      = Slug -> Maybe Slug
forall a. a -> Maybe a
Just (Slug -> Maybe Slug) -> Slug -> Maybe Slug
forall a b. (a -> b) -> a -> b
$ Text -> Slug
slugify Text
"Welcome to clckwrks"
                                                    , pageSrc :: Markup
pageSrc       = Markup :: [PreProcessor] -> Text -> Trust -> Markup
Markup { preProcessors :: [PreProcessor]
preProcessors = [ PreProcessor
Pandoc ]
                                                                             , trust :: Trust
trust         = Trust
Trusted
                                                                             , markup :: Text
markup        = Text
initialPageMarkup
                                                                             }
                                                    , pageExcerpt :: Maybe Markup
pageExcerpt   = Maybe Markup
forall a. Maybe a
Nothing
                                                    , pageDate :: UTCTime
pageDate      = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
1334089928
                                                    , pageUpdated :: UTCTime
pageUpdated   = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
1334089928
                                                    , pageStatus :: PublishStatus
pageStatus    = PublishStatus
Published
                                                    , pageKind :: PageKind
pageKind      = PageKind
PlainPage
                                                    , pageUUID :: UUID
pageUUID      = Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID) -> Maybe UUID -> UUID
forall a b. (a -> b) -> a -> b
$ String -> Maybe UUID
UUID.fromString String
"c306fe3a-8346-11e1-8001-0021cc712949"
                                                    , pageThemeStyleId :: ThemeStyleId
pageThemeStyleId = Int -> ThemeStyleId
ThemeStyleId Int
0
                                                    }
                                             ]
                          , feedConfig :: FeedConfig
feedConfig = FeedConfig
fc
                          , uacct :: Maybe UACCT
uacct = Maybe UACCT
forall a. Maybe a
Nothing
                          }

pageById :: PageId -> Query PageState (Maybe Page)
pageById :: PageId -> Query PageState (Maybe Page)
pageById PageId
pid =
    do IxSet Page
pgs <- PageState -> IxSet Page
pages (PageState -> IxSet Page)
-> Query PageState PageState -> Query PageState (IxSet Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       Maybe Page -> Query PageState (Maybe Page)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Page -> Query PageState (Maybe Page))
-> Maybe Page -> Query PageState (Maybe Page)
forall a b. (a -> b) -> a -> b
$ IxSet Page -> Maybe Page
forall a. Ord a => IxSet a -> Maybe a
getOne (IxSet Page -> Maybe Page) -> IxSet Page -> Maybe Page
forall a b. (a -> b) -> a -> b
$ IxSet Page
pgs IxSet Page -> PageId -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= PageId
pid

-- | get the 'pageTitle' for 'PageId'
getPageTitle :: PageId -> Query PageState (Maybe (Text, Maybe Slug))
getPageTitle :: PageId -> Query PageState (Maybe (Text, Maybe Slug))
getPageTitle PageId
pid =
    do Maybe Page
mPage <- PageId -> Query PageState (Maybe Page)
pageById PageId
pid
       case Maybe Page
mPage of
         Maybe Page
Nothing     -> Maybe (Text, Maybe Slug)
-> Query PageState (Maybe (Text, Maybe Slug))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, Maybe Slug)
 -> Query PageState (Maybe (Text, Maybe Slug)))
-> Maybe (Text, Maybe Slug)
-> Query PageState (Maybe (Text, Maybe Slug))
forall a b. (a -> b) -> a -> b
$ Maybe (Text, Maybe Slug)
forall a. Maybe a
Nothing
         (Just Page
page) -> Maybe (Text, Maybe Slug)
-> Query PageState (Maybe (Text, Maybe Slug))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, Maybe Slug)
 -> Query PageState (Maybe (Text, Maybe Slug)))
-> Maybe (Text, Maybe Slug)
-> Query PageState (Maybe (Text, Maybe Slug))
forall a b. (a -> b) -> a -> b
$ (Text, Maybe Slug) -> Maybe (Text, Maybe Slug)
forall a. a -> Maybe a
Just (Page -> Text
pageTitle Page
page, Page -> Maybe Slug
pageSlug Page
page)

-- | check if the 'PageId' corresponds to a published 'PageId'
isPublishedPage :: PageId -> Query PageState Bool
isPublishedPage :: PageId -> Query PageState Bool
isPublishedPage PageId
pid =
    do IxSet Page
pgs <- PageState -> IxSet Page
pages (PageState -> IxSet Page)
-> Query PageState PageState -> Query PageState (IxSet Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       case IxSet Page -> Maybe Page
forall a. Ord a => IxSet a -> Maybe a
getOne (IxSet Page -> Maybe Page) -> IxSet Page -> Maybe Page
forall a b. (a -> b) -> a -> b
$ IxSet Page
pgs IxSet Page -> PageId -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= PageId
pid of
         Maybe Page
Nothing     -> Bool -> Query PageState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         (Just Page
page) -> Bool -> Query PageState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Query PageState Bool) -> Bool -> Query PageState Bool
forall a b. (a -> b) -> a -> b
$ Page -> PublishStatus
pageStatus Page
page PublishStatus -> PublishStatus -> Bool
forall a. Eq a => a -> a -> Bool
== PublishStatus
Published

pagesSummary :: Query PageState [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
pagesSummary :: Query
  PageState
  [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
pagesSummary =
    do IxSet Page
pgs <- PageState -> IxSet Page
pages (PageState -> IxSet Page)
-> Query PageState PageState -> Query PageState (IxSet Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
-> Query
     PageState
     [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
 -> Query
      PageState
      [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)])
-> [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
-> Query
     PageState
     [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
forall a b. (a -> b) -> a -> b
$ (Page
 -> (PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus))
-> [Page]
-> [(PageId, Text, Maybe Slug, UTCTime, UserId, PublishStatus)]
forall a b. (a -> b) -> [a] -> [b]
map (\Page
page -> (Page -> PageId
pageId Page
page, Page -> Text
pageTitle Page
page, Page -> Maybe Slug
pageSlug Page
page, Page -> UTCTime
pageUpdated Page
page, Page -> UserId
pageAuthor Page
page, Page -> PublishStatus
pageStatus Page
page))
                  (IxSet Page -> [Page]
forall a. Ord a => IxSet a -> [a]
toList IxSet Page
pgs)

updatePage :: Page -> Update PageState (Maybe String)
updatePage :: Page -> Update PageState (Maybe String)
updatePage Page
page =
    do ps :: PageState
ps@PageState{Maybe UACCT
IxSet Page
PageId
FeedConfig
uacct :: Maybe UACCT
feedConfig :: FeedConfig
pages :: IxSet Page
nextPageId :: PageId
uacct :: PageState -> Maybe UACCT
feedConfig :: PageState -> FeedConfig
pages :: PageState -> IxSet Page
nextPageId :: PageState -> PageId
..} <- Update PageState PageState
forall s (m :: * -> *). MonadState s m => m s
get
       case IxSet Page -> Maybe Page
forall a. Ord a => IxSet a -> Maybe a
getOne (IxSet Page -> Maybe Page) -> IxSet Page -> Maybe Page
forall a b. (a -> b) -> a -> b
$ IxSet Page
pages IxSet Page -> PageId -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= (Page -> PageId
pageId Page
page) of
         Maybe Page
Nothing  -> Maybe String -> Update PageState (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Update PageState (Maybe String))
-> Maybe String -> Update PageState (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"updatePage: Invalid PageId " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (PageId -> Integer
unPageId (PageId -> Integer) -> PageId -> Integer
forall a b. (a -> b) -> a -> b
$ Page -> PageId
pageId Page
page)
         (Just Page
_) ->
             do PageState -> Update PageState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (PageState -> Update PageState ())
-> PageState -> Update PageState ()
forall a b. (a -> b) -> a -> b
$ PageState
ps { pages :: IxSet Page
pages = PageId -> Page -> IxSet Page -> IxSet Page
forall a k.
(Indexable a, Ord a, Typeable a, Typeable k) =>
k -> a -> IxSet a -> IxSet a
updateIx (Page -> PageId
pageId Page
page) Page
page IxSet Page
pages }
                Maybe String -> Update PageState (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

newPage :: PageKind -> UserId -> UUID -> UTCTime -> Update PageState Page
newPage :: PageKind -> UserId -> UUID -> UTCTime -> Update PageState Page
newPage PageKind
pk UserId
uid UUID
uuid UTCTime
now =
    do ps :: PageState
ps@PageState{Maybe UACCT
IxSet Page
PageId
FeedConfig
uacct :: Maybe UACCT
feedConfig :: FeedConfig
pages :: IxSet Page
nextPageId :: PageId
uacct :: PageState -> Maybe UACCT
feedConfig :: PageState -> FeedConfig
pages :: PageState -> IxSet Page
nextPageId :: PageState -> PageId
..} <- Update PageState PageState
forall s (m :: * -> *). MonadState s m => m s
get
       let page :: Page
page = Page :: PageId
-> UserId
-> Text
-> Maybe Slug
-> Markup
-> Maybe Markup
-> UTCTime
-> UTCTime
-> PublishStatus
-> PageKind
-> UUID
-> ThemeStyleId
-> Page
Page { pageId :: PageId
pageId      = PageId
nextPageId
                       , pageAuthor :: UserId
pageAuthor  = UserId
uid
                       , pageTitle :: Text
pageTitle   = Text
"Untitled"
                       , pageSlug :: Maybe Slug
pageSlug    = Maybe Slug
forall a. Maybe a
Nothing
                       , pageSrc :: Markup
pageSrc     = Markup :: [PreProcessor] -> Text -> Trust -> Markup
Markup { preProcessors :: [PreProcessor]
preProcessors = [ PreProcessor
Pandoc ]
                                              , trust :: Trust
trust         = Trust
Trusted
                                              , markup :: Text
markup        = Text
Text.empty
                                              }
                       , pageExcerpt :: Maybe Markup
pageExcerpt = Maybe Markup
forall a. Maybe a
Nothing
                       , pageDate :: UTCTime
pageDate    = UTCTime
now
                       , pageUpdated :: UTCTime
pageUpdated = UTCTime
now
                       , pageStatus :: PublishStatus
pageStatus  = PublishStatus
Draft
                       , pageKind :: PageKind
pageKind    = PageKind
pk
                       , pageUUID :: UUID
pageUUID    = UUID
uuid
                       , pageThemeStyleId :: ThemeStyleId
pageThemeStyleId = Int -> ThemeStyleId
ThemeStyleId Int
0
                       }
       PageState -> Update PageState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (PageState -> Update PageState ())
-> PageState -> Update PageState ()
forall a b. (a -> b) -> a -> b
$ PageState
ps { nextPageId :: PageId
nextPageId = Integer -> PageId
PageId (Integer -> PageId) -> Integer -> PageId
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ PageId -> Integer
unPageId PageId
nextPageId
                , pages :: IxSet Page
pages      = Page -> IxSet Page -> IxSet Page
forall a.
(Typeable a, Ord a, Indexable a) =>
a -> IxSet a -> IxSet a
insert Page
page IxSet Page
pages
                }
       Page -> Update PageState Page
forall (m :: * -> *) a. Monad m => a -> m a
return Page
page

getFeedConfig :: Query PageState FeedConfig
getFeedConfig :: Query PageState FeedConfig
getFeedConfig =
    do PageState{Maybe UACCT
IxSet Page
PageId
FeedConfig
uacct :: Maybe UACCT
feedConfig :: FeedConfig
pages :: IxSet Page
nextPageId :: PageId
uacct :: PageState -> Maybe UACCT
feedConfig :: PageState -> FeedConfig
pages :: PageState -> IxSet Page
nextPageId :: PageState -> PageId
..} <- Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       FeedConfig -> Query PageState FeedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return FeedConfig
feedConfig

getBlogTitle :: Query PageState Text
getBlogTitle :: Query PageState Text
getBlogTitle =
    do PageState{Maybe UACCT
IxSet Page
PageId
FeedConfig
uacct :: Maybe UACCT
feedConfig :: FeedConfig
pages :: IxSet Page
nextPageId :: PageId
uacct :: PageState -> Maybe UACCT
feedConfig :: PageState -> FeedConfig
pages :: PageState -> IxSet Page
nextPageId :: PageState -> PageId
..} <- Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       Text -> Query PageState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (FeedConfig -> Text
feedTitle FeedConfig
feedConfig)

setFeedConfig :: FeedConfig -> Update PageState ()
setFeedConfig :: FeedConfig -> Update PageState ()
setFeedConfig FeedConfig
fc =
    do PageState
ps <- Update PageState PageState
forall s (m :: * -> *). MonadState s m => m s
get
       PageState -> Update PageState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (PageState -> Update PageState ())
-> PageState -> Update PageState ()
forall a b. (a -> b) -> a -> b
$ PageState
ps { feedConfig :: FeedConfig
feedConfig = FeedConfig
fc }

-- | get all 'Published' posts, sorted reverse cronological
allPosts :: Query PageState [Page]
allPosts :: Query PageState [Page]
allPosts =
    do IxSet Page
pgs <- PageState -> IxSet Page
pages (PageState -> IxSet Page)
-> Query PageState PageState -> Query PageState (IxSet Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       [Page] -> Query PageState [Page]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Page] -> Query PageState [Page])
-> [Page] -> Query PageState [Page]
forall a b. (a -> b) -> a -> b
$ Proxy UTCTime -> IxSet Page -> [Page]
forall k a.
(Indexable a, Typeable a, Typeable k) =>
Proxy k -> IxSet a -> [a]
toDescList (Proxy UTCTime
forall a. Proxy a
Proxy :: Proxy UTCTime) (IxSet Page
pgs IxSet Page -> PageKind -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= PageKind
Post IxSet Page -> PublishStatus -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= PublishStatus
Published)

-- | get all 'Published' pages, sorted in no particular order
allPublishedPages :: Query PageState [Page]
allPublishedPages :: Query PageState [Page]
allPublishedPages =
    do IxSet Page
pgs <- PageState -> IxSet Page
pages (PageState -> IxSet Page)
-> Query PageState PageState -> Query PageState (IxSet Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask
       [Page] -> Query PageState [Page]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Page] -> Query PageState [Page])
-> [Page] -> Query PageState [Page]
forall a b. (a -> b) -> a -> b
$ IxSet Page -> [Page]
forall a. Ord a => IxSet a -> [a]
toList (IxSet Page
pgs IxSet Page -> PageKind -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= PageKind
PlainPage IxSet Page -> PublishStatus -> IxSet Page
forall a k.
(Indexable a, Typeable a, Ord a, Typeable k) =>
IxSet a -> k -> IxSet a
@= PublishStatus
Published)

-- | get the 'UACCT' for Google Analytics
--
-- DEPRECATED: moved to clckwrks / 'CoreState'
getOldUACCT :: Query PageState (Maybe UACCT)
getOldUACCT :: Query PageState (Maybe UACCT)
getOldUACCT = PageState -> Maybe UACCT
uacct (PageState -> Maybe UACCT)
-> Query PageState PageState -> Query PageState (Maybe UACCT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query PageState PageState
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | zero out the UACCT code in 'PageState'. It belongs in 'CoreState'
-- now.
clearOldUACCT :: Update PageState ()
clearOldUACCT :: Update PageState ()
clearOldUACCT = (PageState -> PageState) -> Update PageState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PageState -> PageState) -> Update PageState ())
-> (PageState -> PageState) -> Update PageState ()
forall a b. (a -> b) -> a -> b
$ \PageState
ps -> PageState
ps { uacct :: Maybe UACCT
uacct = Maybe UACCT
forall a. Maybe a
Nothing }

$(makeAcidic ''PageState
  [ 'newPage
  , 'pageById
  , 'getPageTitle
  , 'isPublishedPage
  , 'pagesSummary
  , 'updatePage
  , 'allPosts
  , 'allPublishedPages
  , 'getFeedConfig
  , 'setFeedConfig
  , 'getBlogTitle
  , 'getOldUACCT
  , 'clearOldUACCT
  ])