{-# LANGUAGE RecordWildCards, FlexibleContexts, Rank2Types, OverloadedStrings #-}
module Clckwrks.Plugin where

import Clckwrks
import Clckwrks.Types              (NamedLink(..))
import Clckwrks.Route              (routeClck)
import Control.Monad.State         (get)
import Data.Text                   (Text)
import qualified Data.Set          as Set
import qualified Data.Text.Lazy as TL
import Web.Plugins.Core            (Plugin(..), addHandler, getPluginRouteFn, initPlugin)

clckHandler :: (ClckURL -> [(Text, Maybe Text)] -> Text)
            -> ClckPlugins
            -> [Text]
            -> ClckT ClckURL (ServerPartT IO) Response
clckHandler :: (ClckURL -> [(Text, Maybe Text)] -> Text)
-> ClckPlugins -> [Text] -> ClckT ClckURL (ServerPartT IO) Response
clckHandler ClckURL -> [(Text, Maybe Text)] -> Text
showRouteFn ClckPlugins
_plugins [Text]
paths =
    case URLParser ClckURL -> [Text] -> Either String ClckURL
forall a. URLParser a -> [Text] -> Either String a
parseSegments URLParser ClckURL
forall url. PathInfo url => URLParser url
fromPathSegments [Text]
paths of
      (Left String
e)  -> Response -> ClckT ClckURL (ServerPartT IO) Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
notFound (Response -> ClckT ClckURL (ServerPartT IO) Response)
-> Response -> ClckT ClckURL (ServerPartT IO) Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse (String -> String
forall a. Show a => a -> String
show String
e)
      (Right ClckURL
u) -> ClckURL -> ClckT ClckURL (ServerPartT IO) Response
routeClck ClckURL
u

clckMenuCallback :: ClckT ClckURL IO (String, [NamedLink])
clckMenuCallback :: ClckT ClckURL IO (String, [NamedLink])
clckMenuCallback =
    do Text
adminURL <- URL (ClckT ClckURL IO) -> ClckT ClckURL IO Text
forall (m :: * -> *). MonadRoute m => URL m -> m Text
showURL (AdminURL -> ClckURL
Admin AdminURL
Console)
       (String, [NamedLink]) -> ClckT ClckURL IO (String, [NamedLink])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Clck", [Text -> Text -> NamedLink
NamedLink Text
"Admin" Text
adminURL])

clckInit :: ClckPlugins
         -> IO (Maybe Text)
clckInit :: ClckPlugins -> IO (Maybe Text)
clckInit ClckPlugins
plugins =
    do ~(Just ClckURL -> [(Text, Maybe Text)] -> Text
clckShowFn) <- ClckPlugins
-> Text -> IO (Maybe (ClckURL -> [(Text, Maybe Text)] -> Text))
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> Text -> m (Maybe (url -> [(Text, Maybe Text)] -> Text))
getPluginRouteFn ClckPlugins
plugins (Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
clckPlugin)
       ClckPlugins -> ClckT ClckURL IO (String, [NamedLink]) -> IO ()
forall (m :: * -> *) theme n hook config.
MonadIO m =>
Plugins theme n hook config ClckPluginsSt
-> ClckT ClckURL IO (String, [NamedLink]) -> m ()
addNavBarCallback ClckPlugins
plugins ClckT ClckURL IO (String, [NamedLink])
clckMenuCallback
       ClckPlugins
-> Text
-> (ClckPlugins
    -> [Text] -> ClckT ClckURL (ServerPartT IO) Response)
-> IO ()
forall (m :: * -> *) theme n hook config st.
MonadIO m =>
Plugins theme n hook config st
-> Text -> (Plugins theme n hook config st -> [Text] -> n) -> m ()
addHandler ClckPlugins
plugins (Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
clckPlugin) ((ClckURL -> [(Text, Maybe Text)] -> Text)
-> ClckPlugins -> [Text] -> ClckT ClckURL (ServerPartT IO) Response
clckHandler ClckURL -> [(Text, Maybe Text)] -> Text
clckShowFn)
       Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

addClckAdminMenu :: ClckT url IO ()
addClckAdminMenu :: ClckT url IO ()
addClckAdminMenu =
    do ClckPlugins
p <- ClckState -> ClckPlugins
plugins (ClckState -> ClckPlugins)
-> ClckT url IO ClckState -> ClckT url IO ClckPlugins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClckT url IO ClckState
forall s (m :: * -> *). MonadState s m => m s
get
       ~(Just ClckURL -> [(Text, Maybe Text)] -> Text
clckShowURL) <- ClckPlugins
-> Text
-> ClckT url IO (Maybe (ClckURL -> [(Text, Maybe Text)] -> Text))
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> Text -> m (Maybe (url -> [(Text, Maybe Text)] -> Text))
getPluginRouteFn ClckPlugins
p (Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
clckPlugin)
       (Text, [(Set Role, Text, Text)]) -> ClckT url IO ()
forall (m :: * -> *) url.
Monad m =>
(Text, [(Set Role, Text, Text)]) -> ClckT url m ()
addAdminMenu ( Text
"Profile"
                    , [ ([Role] -> Set Role
forall a. Ord a => [a] -> Set a
Set.fromList [Role
Administrator, Role
Visitor], Text
"Edit Your Profile"      , ClckURL -> [(Text, Maybe Text)] -> Text
clckShowURL (ProfileDataURL -> ClckURL
Profile ProfileDataURL
EditProfileData) [])
                      ]
                    )

       (Text, [(Set Role, Text, Text)]) -> ClckT url IO ()
forall (m :: * -> *) url.
Monad m =>
(Text, [(Set Role, Text, Text)]) -> ClckT url m ()
addAdminMenu ( Text
"Clckwrks"
                    , [ (Role -> Set Role
forall a. a -> Set a
Set.singleton Role
Administrator, Text
"Console"       , ClckURL -> [(Text, Maybe Text)] -> Text
clckShowURL (AdminURL -> ClckURL
Admin AdminURL
Console)      [])
                      , (Role -> Set Role
forall a. a -> Set a
Set.singleton Role
Administrator, Text
"Edit Settings" , ClckURL -> [(Text, Maybe Text)] -> Text
clckShowURL (AdminURL -> ClckURL
Admin AdminURL
EditSettings) [])
                      , (Role -> Set Role
forall a. a -> Set a
Set.singleton Role
Administrator, Text
"Edit Nav Bar"  , ClckURL -> [(Text, Maybe Text)] -> Text
clckShowURL (AdminURL -> ClckURL
Admin AdminURL
EditNavBar)   [])
                      , (Role -> Set Role
forall a. a -> Set a
Set.singleton Role
Administrator, Text
"System Emails" , ClckURL -> [(Text, Maybe Text)] -> Text
clckShowURL (AdminURL -> ClckURL
Admin AdminURL
SystemEmails) [])
                      ]
                    )

clckPlugin :: Plugin ClckURL Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig ClckPluginsSt
clckPlugin :: Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
clckPlugin = Plugin :: forall url theme n hook config st.
Text
-> (Plugins theme n hook config st -> IO (Maybe Text))
-> [Text]
-> (url -> [Text])
-> hook
-> Plugin url theme n hook config st
Plugin
    { pluginName :: Text
pluginName           = Text
"clck"
    , pluginInit :: ClckPlugins -> IO (Maybe Text)
pluginInit           = ClckPlugins -> IO (Maybe Text)
clckInit
    , pluginDepends :: [Text]
pluginDepends        = []
    , pluginToPathSegments :: ClckURL -> [Text]
pluginToPathSegments = ClckURL -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments
    , pluginPostHook :: ClckT ClckURL IO ()
pluginPostHook       = ClckT ClckURL IO ()
forall url. ClckT url IO ()
addClckAdminMenu
    }

plugin :: ClckPlugins
       -> Text
       -> IO (Maybe Text)
plugin :: ClckPlugins -> Text -> IO (Maybe Text)
plugin ClckPlugins
plugins Text
baseURI =
    ClckPlugins
-> Text
-> Plugin
     ClckURL
     Theme
     (ClckT ClckURL (ServerPartT IO) Response)
     (ClckT ClckURL IO ())
     ClckwrksConfig
     ClckPluginsSt
-> IO (Maybe Text)
forall url theme n hook config st.
Typeable url =>
Plugins theme n hook config st
-> Text -> Plugin url theme n hook config st -> IO (Maybe Text)
initPlugin ClckPlugins
plugins Text
baseURI Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
clckPlugin