module Yesod.Goodies.PNotify ( module Yesod.Goodies.PNotify.Types , module Yesod.Goodies.PNotify.Types.Instances , module Buttons , module Confirm , module Desktop , module History , module Nonblock , module Reference , module Stack , PNotify(..) , YesodJqueryPnotify(..) , getPNotify , setPNotify -- Utility , pnotify , defaultPNotify ) where import Yesod import Yesod.Form.Jquery hiding (urlJqueryJs, urlJqueryUiCss) import Control.Monad (mzero) import Control.Monad.Trans.Maybe import Data.Aeson (FromJSON(..), ToJSON(..), encode, decode, (.:?)) import Data.List (nub) import Data.Maybe (isJust, fromJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL (decodeUtf8, encodeUtf8) import Text.Julius (RawJS(..)) import Yesod.Goodies.PNotify.Types import Yesod.Goodies.PNotify.Types.Instances import qualified Yesod.Goodies.PNotify.Modules.Buttons as Buttons import qualified Yesod.Goodies.PNotify.Modules.Confirm as Confirm import qualified Yesod.Goodies.PNotify.Modules.Desktop as Desktop import qualified Yesod.Goodies.PNotify.Modules.History as History import qualified Yesod.Goodies.PNotify.Modules.Nonblock as Nonblock import qualified Yesod.Goodies.PNotify.Modules.Reference as Reference import qualified Yesod.Goodies.PNotify.Modules.Stack as Stack data PNotify = PNotify { _title :: Maybe (Either Bool Text) , _title_escape :: Maybe (Either Bool Text) , _text :: Maybe (Either Bool Text) , _text_escape :: Maybe (Either Bool Text) , _styling :: Maybe NotifyStyling , _addclass :: Maybe Text , _cornerclass :: Maybe Text , _auto_display :: Maybe Bool , _width :: Maybe Text , _min_height :: Maybe Text , _type :: Maybe NotifyType , _icon :: Maybe (Either Bool Text) , _animation :: Maybe AnimationType , _animate_speed :: Maybe AnimateSpeed , _position_animate_speed :: Maybe Int , _opacity :: Maybe Double , _shadow :: Maybe Bool , _hide :: Maybe Bool , _delay :: Maybe Int , _mouse_reset :: Maybe Bool , _remove :: Maybe Bool , _insert_brs :: Maybe Bool , _stack :: Maybe Stack.Stack , _buttons :: Maybe Buttons.Buttons , _confirm :: Maybe Confirm.Confirm , _desktop :: Maybe Desktop.Desktop , _history :: Maybe History.History , _nonblock :: Maybe Nonblock.Nonblock , _reference :: Maybe Reference.Reference } deriving (Show, Read, Eq, Ord) instance FromJSON PNotify where parseJSON (Object v) = PNotify <$> v .:? "title" <*> v .:? "title_escape" <*> v .:? "text" <*> v .:? "text_escape" <*> v .:? "styling" <*> v .:? "addclass" <*> v .:? "cornerclass" <*> v .:? "auto_display" <*> v .:? "width" <*> v .:? "min_height" <*> v .:? "type" <*> v .:? "icon" <*> v .:? "animation" <*> v .:? "animate_speed" <*> v .:? "position_animate_speed" <*> v .:? "opacity" <*> v .:? "shadow" <*> v .:? "hide" <*> v .:? "delay" <*> v .:? "mouse_reset" <*> v .:? "remove" <*> v .:? "insert_brs" <*> v .:? "stack" <*> v .:? "buttons" <*> v .:? "confirm" <*> v .:? "desktop" <*> v .:? "history" <*> v .:? "nonblock" <*> v .:? "reference" parseJSON _ = mzero instance ToJSON PNotify where toJSON (PNotify { _title , _title_escape , _text , _text_escape , _styling , _addclass , _cornerclass , _auto_display , _width , _min_height , _type , _icon , _animation , _animate_speed , _position_animate_speed , _opacity , _shadow , _hide , _delay , _mouse_reset , _remove , _insert_brs , _stack , _buttons , _confirm , _desktop , _history , _nonblock , _reference }) = object $ maybe [] (\x -> ["title" .= x]) _title ++ maybe [] (\x -> ["title_escape" .= x]) _title_escape ++ maybe [] (\x -> ["text" .= x]) _text ++ maybe [] (\x -> ["text_escape" .= x]) _text_escape ++ maybe [] (\x -> ["styling" .= x]) _styling ++ maybe [] (\x -> ["addclass" .= x]) _addclass ++ maybe [] (\x -> ["cornerclass" .= x]) _cornerclass ++ maybe [] (\x -> ["auto_display" .= x]) _auto_display ++ maybe [] (\x -> ["width" .= x]) _width ++ maybe [] (\x -> ["min_height" .= x]) _min_height ++ maybe [] (\x -> ["type" .= x]) _type ++ maybe [] (\x -> ["icon" .= x]) _icon ++ maybe [] (\x -> ["animation" .= x]) _animation ++ maybe [] (\x -> ["animate_speed" .= x]) _animate_speed ++ maybe [] (\x -> ["position_animate_speed" .= x]) _position_animate_speed ++ maybe [] (\x -> ["opacity" .= x]) _opacity ++ maybe [] (\x -> ["shadow" .= x]) _shadow ++ maybe [] (\x -> ["hide" .= x]) _hide ++ maybe [] (\x -> ["delay" .= x]) _delay ++ maybe [] (\x -> ["mouse_reset" .= x]) _mouse_reset ++ maybe [] (\x -> ["remove" .= x]) _remove ++ maybe [] (\x -> ["insert_brs" .= x]) _insert_brs ++ maybe [] (\x -> ["stack" .= x]) _stack ++ maybe [] (\x -> ["buttons" .= x]) _buttons ++ maybe [] (\x -> ["confirm" .= x]) _confirm ++ maybe [] (\x -> ["desktop" .= x]) _desktop ++ maybe [] (\x -> ["history" .= x]) _history ++ maybe [] (\x -> ["nonblcok" .= x]) _nonblock ++ maybe [] (\x -> ["reference" .= x]) _reference ++ [] defaultPNotify :: PNotify defaultPNotify = PNotify { _title = Nothing , _title_escape = Nothing , _text = Nothing , _text_escape = Nothing , _styling = Nothing , _addclass = Nothing , _cornerclass = Nothing , _auto_display = Nothing , _width = Nothing , _min_height = Nothing , _type = Nothing , _icon = Nothing , _animation = Nothing , _animate_speed = Nothing , _position_animate_speed = Nothing , _opacity = Nothing , _shadow = Nothing , _hide = Nothing , _delay = Nothing , _mouse_reset = Nothing , _remove = Nothing , _insert_brs = Nothing , _stack = Nothing , _buttons = Nothing , _confirm = Nothing , _desktop = Nothing , _history = Nothing , _nonblock = Nothing , _reference = Nothing } instance RawJS [PNotify] where rawJS = rawJS . TL.decodeUtf8 . encode class YesodJquery a => YesodJqueryPnotify a where urlJqueryJs :: a -> Either (Route a) Text urlJqueryJs _ = Right "//ajax.googleapis.com/ajax/libs/jquery/2.2.0/jquery.min.js" urlJqueryUiCss :: a -> Either (Route a) Text urlJqueryUiCss _ = Right "//ajax.googleapis.com/ajax/libs/jqueryui/1.11.4/themes/smoothness/jquery-ui.css" urlPnotifyBrightthemeCss :: a -> Either (Route a) Text urlPnotifyBrightthemeCss _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.brighttheme.min.css" urlPnotifyButtonsJs :: a -> Either (Route a) Text urlPnotifyButtonsJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.buttons.min.js" urlPnotifyButtonsCss :: a -> Either (Route a) Text urlPnotifyButtonsCss _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.buttons.min.css" urlPnotifyCallbacksJs :: a -> Either (Route a) Text urlPnotifyCallbacksJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.callbacks.min.js" urlPnotifyConfirmJs :: a -> Either (Route a) Text urlPnotifyConfirmJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.confirm.min.js" urlPnotifyCoreJs :: a -> Either (Route a) Text urlPnotifyCoreJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.core.min.js" urlPnotifyCoreCss :: a -> Either (Route a) Text urlPnotifyCoreCss _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.core.min.css" urlPnotifyDesktopJs :: a -> Either (Route a) Text urlPnotifyDesktopJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.desktop.min.js" urlPnotifyHistoryJs :: a -> Either (Route a) Text urlPnotifyHistoryJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.history.min.js" urlPnotifyHistoryCss :: a -> Either (Route a) Text urlPnotifyHistoryCss _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.history.min.css" urlPnotifyMobileJs :: a -> Either (Route a) Text urlPnotifyMobileJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.mobile.min.js" urlPnotifyNonblockJs :: a -> Either (Route a) Text urlPnotifyNonblockJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.nonblock.min.js" urlPnotifyPiconCss :: a -> Either (Route a) Text urlPnotifyPiconCss _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.picon.min.css" urlPnotifyReferenceJs :: a -> Either (Route a) Text urlPnotifyReferenceJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.reference.min.js" urlPnotifyTooltipJs :: a -> Either (Route a) Text urlPnotifyTooltipJs _ = Right "//cdn.css.net/libs/pnotify/2.1.0/pnotify.tooltip.min.js" urlBootstrap3Js :: a -> Either (Route a) Text urlBootstrap3Js _ = Right "//netdna.bootstrapcdn.com/bootstrap/3.3.6/js/bootstrap.min.js" urlBootstrap3Css :: a -> Either (Route a) Text urlBootstrap3Css _ = Right "//netdna.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css" urlBrightThemeCss :: a -> Either (Route a) Text urlBrightThemeCss _ = Right "//cdnjs.cloudflare.com/ajax/libs/pnotify/2.1.0/pnotify.brighttheme.min.css" urlFontAwesomeCss :: a -> Either (Route a) Text urlFontAwesomeCss _ = Right "//netdna.bootstrapcdn.com/font-awesome/4.4.0/css/font-awesome.min.css" notifyKey :: Text notifyKey = "_PNotify" toText :: [PNotify] -> Text toText = TL.toStrict . TL.decodeUtf8 . encode fromText :: Text -> [PNotify] fromText = maybe [] id . decode . TL.encodeUtf8 . TL.fromStrict _setPNotify :: [PNotify] -> HandlerT site IO () _setPNotify = setSession notifyKey . toText getPNotify :: HandlerT site IO (Maybe [PNotify]) getPNotify = runMaybeT $ do ns <- MaybeT $ lookupSession notifyKey lift $ deleteSession notifyKey return $ fromText ns setPNotify :: PNotify -> HandlerT site IO () setPNotify n = do mns <- getPNotify _setPNotify (n:maybe [] id mns) optionalLoadJsCss :: (MonadWidget m, YesodJqueryPnotify (HandlerSite m)) => HandlerSite m -> [PNotify] -> m() optionalLoadJsCss y = mapM_ trans . uniqueAsDefault BrightTheme where uniqueAsDefault def = nub . map (maybe def id . _styling) trans s = case s of JqueryUI -> addStylesheetEither $ urlJqueryUiCss y Bootstrap3 -> do { addScriptEither $ urlBootstrap3Js y ; addStylesheetEither $ urlBootstrap3Css y } BrightTheme -> addStylesheetEither $ urlBrightThemeCss y FontAwesome -> addStylesheetEither $ urlFontAwesomeCss y pnotify :: YesodJqueryPnotify site => site -> WidgetT site IO () pnotify y = do mnotify <- handlerToWidget getPNotify case mnotify of Nothing -> return () Just ps -> do addScriptEither $ urlJqueryJs y addScriptEither $ urlPnotifyCoreJs y addStylesheetEither $ urlPnotifyCoreCss y addStylesheetEither $ urlPnotifyBrightthemeCss y addScriptEither $ urlPnotifyButtonsJs y addStylesheetEither $ urlPnotifyButtonsCss y addScriptEither $ urlPnotifyCallbacksJs y addScriptEither $ urlPnotifyConfirmJs y addScriptEither $ urlPnotifyDesktopJs y addScriptEither $ urlPnotifyHistoryJs y addStylesheetEither $ urlPnotifyHistoryCss y addScriptEither $ urlPnotifyMobileJs y addScriptEither $ urlPnotifyNonblockJs y addStylesheetEither $ urlPnotifyPiconCss y addScriptEither $ urlPnotifyReferenceJs y addScriptEither $ urlPnotifyTooltipJs y optionalLoadJsCss y ps toWidget [julius|$(function(){$.each(#{rawJS ps},function(i,v){new PNotify(v)});});|]