{-# LANGUAGE OverloadedStrings #-}
module Clckwrks.Page.NavBarCallback where

import Clckwrks            (ClckT, ClckURL, NamedLink(..), query)
import Clckwrks.Page.Acid  (AllPublishedPages(..), PageState)
import Clckwrks.Page.Types (Page(..))
import Clckwrks.Page.URL   (PageURL(..))
import Data.Acid           (AcidState)
import Data.Acid.Advanced  (query')
import Data.Function       (on)
import Data.List           (sortBy)
import Data.Text           (Text)

navBarCallback :: AcidState PageState
             -> (PageURL -> [(Text, Maybe Text)] -> Text)
             -> ClckT ClckURL IO (String, [NamedLink])
navBarCallback :: AcidState PageState
-> (PageURL -> [(Text, Maybe Text)] -> Text)
-> ClckT ClckURL IO (String, [NamedLink])
navBarCallback AcidState PageState
acidPageState PageURL -> [(Text, Maybe Text)] -> Text
showPageURL =
    do [Page]
pages <- AcidState (EventState AllPublishedPages)
-> AllPublishedPages
-> ClckT ClckURL IO (EventResult AllPublishedPages)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState AllPublishedPages)
AcidState PageState
acidPageState AllPublishedPages
AllPublishedPages
       let blogLink :: NamedLink
blogLink  = NamedLink :: Text -> Text -> NamedLink
NamedLink { namedLinkTitle :: Text
namedLinkTitle = Text
"Blog", namedLinkURL :: Text
namedLinkURL = PageURL -> [(Text, Maybe Text)] -> Text
showPageURL PageURL
Blog [] }
           pageLinks :: [NamedLink]
pageLinks = (Page -> NamedLink) -> [Page] -> [NamedLink]
forall a b. (a -> b) -> [a] -> [b]
map (\Page
p -> Text -> Text -> NamedLink
NamedLink (Page -> Text
pageTitle Page
p) (PageURL -> [(Text, Maybe Text)] -> Text
showPageURL (PageId -> PageURL
ViewPage (Page -> PageId
pageId Page
p)) [])) [Page]
pages
       (String, [NamedLink]) -> ClckT ClckURL IO (String, [NamedLink])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Page", NamedLink
blogLink NamedLink -> [NamedLink] -> [NamedLink]
forall a. a -> [a] -> [a]
: ((NamedLink -> NamedLink -> Ordering) -> [NamedLink] -> [NamedLink]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (NamedLink -> Text) -> NamedLink -> NamedLink -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NamedLink -> Text
namedLinkTitle) [NamedLink]
pageLinks))