yesod-pnotify 1.1.0 → 1.1.1
raw patch · 10 files changed
+678/−1 lines, 10 files
Files
- Yesod/Goodies/PNotify/Modules/Buttons.hs +72/−0
- Yesod/Goodies/PNotify/Modules/Confirm.hs +117/−0
- Yesod/Goodies/PNotify/Modules/Desktop.hs +45/−0
- Yesod/Goodies/PNotify/Modules/History.hs +71/−0
- Yesod/Goodies/PNotify/Modules/Nonblock.hs +34/−0
- Yesod/Goodies/PNotify/Modules/Reference.hs +48/−0
- Yesod/Goodies/PNotify/Modules/Stack.hs +134/−0
- Yesod/Goodies/PNotify/Types.hs +28/−0
- Yesod/Goodies/PNotify/Types/Instances.hs +119/−0
- yesod-pnotify.cabal +10/−1
+ Yesod/Goodies/PNotify/Modules/Buttons.hs view
@@ -0,0 +1,72 @@+module Yesod.Goodies.PNotify.Modules.Buttons+ ( Buttons(..)+ , defaultButtons+ )where++import Data.Aeson+import Data.Text (Text)++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances++data Labels = Labels { _close :: Maybe Text+ , _stick :: Maybe Text+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Labels where+ parseJSON (Object v) = Labels <$>+ v .:? "close" <*>+ v .:? "stick"++instance ToJSON Labels where+ toJSON (Labels { _close+ , _stick+ })+ = object $ maybe [] (\x -> ["close" .= x]) _close +++ maybe [] (\x -> ["stick" .= x]) _stick +++ []++data Buttons = Buttons { _closer :: Maybe Bool+ , _closer_hover :: Maybe Bool+ , _sticker :: Maybe Bool+ , _sticker_hover :: Maybe Bool+ , _show_on_nonblock :: Maybe Bool+ , _labels :: Maybe Labels+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Buttons where+ parseJSON (Object v) = Buttons <$>+ v .:? "closer" <*>+ v .:? "closer_hover" <*>+ v .:? "sticker" <*>+ v .:? "sticker_hover" <*>+ v .:? "show_on_nonblock" <*>+ v .:? "labels"++instance ToJSON Buttons where+ toJSON (Buttons { _closer+ , _closer_hover+ , _sticker+ , _sticker_hover+ , _show_on_nonblock+ , _labels+ })+ = object $ maybe [] (\x -> ["closer" .= x]) _closer +++ maybe [] (\x -> ["closer_hover" .= x]) _closer_hover +++ maybe [] (\x -> ["sticker" .= x]) _sticker +++ maybe [] (\x -> ["sticker_hover" .= x]) _sticker_hover +++ maybe [] (\x -> ["show_on_nonblock" .= x]) _show_on_nonblock +++ maybe [] (\x -> ["labels" .= x]) _labels +++ []++defaultButtons :: Buttons+defaultButtons = Buttons+ { _closer = Nothing+ , _closer_hover = Nothing+ , _sticker = Nothing+ , _sticker_hover = Nothing+ , _show_on_nonblock = Nothing+ , _labels = Nothing+ }
+ Yesod/Goodies/PNotify/Modules/Confirm.hs view
@@ -0,0 +1,117 @@+module Yesod.Goodies.PNotify.Modules.Confirm+ ( Confirm(..)+ , defaultConfirm+ )where++import Prelude hiding (Either(..))+import Control.Monad (mzero)+import Data.Aeson+import Data.Text (Text)+import qualified Data.Text as T++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances++data Align = Right+ | Left+ | Center+ | Justify+ deriving (Eq, Ord, Enum)++instance Read Align where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "right" -> (Right, s')+ "left" -> (Left, s')+ "center" -> (Center, s')+ "justify" -> (Justify, s')+ _ -> error $ "invalid Align " ++ v++instance Show Align where+ show Right = "right"+ show Left = "left"+ show Center = "center"+ show Justify = "justify"++instance FromJSON Align where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON Align where+ toJSON Right = String "right"+ toJSON Left = String "left"+ toJSON Center = String "center"+ toJSON Justify = String "justify"+++data Button = Button { _text :: Maybe Text+ , _addClass :: Maybe Text+ , _promptTrigger :: Maybe Bool+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Button where+ parseJSON (Object v) = Button <$>+ v .:? "text" <*>+ v .:? "addClass" <*>+ v .:? "promptTrigger"++instance ToJSON Button where+ toJSON (Button { _text+ , _addClass+ , _promptTrigger+ })+ = object $ maybe [] (\x -> ["text" .= x]) _text +++ maybe [] (\x -> ["addClass" .= x]) _addClass +++ maybe [] (\x -> ["promptTrigger" .= x]) _promptTrigger +++ []++data Confirm = Confirm { _confirm :: Maybe Bool+ , _prompt :: Maybe Bool+ , _prompt_class :: Maybe Text+ , _prompt_default :: Maybe Text+ , _prompt_multi_line :: Maybe Bool+ , _align :: Maybe Align+ , _buttons :: Maybe [Button]+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Confirm where+ parseJSON (Object v) = Confirm <$>+ v .:? "confirm" <*>+ v .:? "prompt" <*>+ v .:? "prompt_class" <*>+ v .:? "prompt_default" <*>+ v .:? "prompt_multi_line" <*>+ v .:? "align" <*>+ v .:? "buttons"++instance ToJSON Confirm where+ toJSON (Confirm { _confirm+ , _prompt+ , _prompt_class+ , _prompt_default+ , _prompt_multi_line+ , _align+ , _buttons+ })+ = object $ maybe [] (\x -> ["confirm" .= x]) _confirm +++ maybe [] (\x -> ["prompt" .= x]) _prompt +++ maybe [] (\x -> ["prompt_class" .= x]) _prompt_class +++ maybe [] (\x -> ["prompt_default" .= x]) _prompt_default +++ maybe [] (\x -> ["prompt_multi_line" .= x]) _prompt_multi_line +++ maybe [] (\x -> ["align" .= x]) _align +++ maybe [] (\x -> ["buttons" .= x]) _buttons +++ []+++defaultConfirm :: Confirm+defaultConfirm = Confirm { _confirm = Nothing+ , _prompt = Nothing+ , _prompt_class = Nothing+ , _prompt_default = Nothing+ , _prompt_multi_line = Nothing+ , _align = Nothing+ , _buttons = Nothing+ }
+ Yesod/Goodies/PNotify/Modules/Desktop.hs view
@@ -0,0 +1,45 @@+module Yesod.Goodies.PNotify.Modules.Desktop+ ( Desktop(..)+ , defaultDesktop+ )where++import Data.Aeson+import Data.Text (Text)++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances++data Desktop = Desktop { _desktop :: Maybe Bool+ , _fallback :: Maybe Bool+ , _icon :: Maybe (Prelude.Either Bool URL)+ , _tag :: Maybe Text+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Desktop where+ parseJSON (Object v) = Desktop <$>+ v .:? "desktop" <*>+ v .:? "fallback" <*>+ v .:? "icon" <*>+ v .:? "tag"++instance ToJSON Desktop where+ toJSON (Desktop { _desktop+ , _fallback+ , _icon+ , _tag+ })+ = object $ maybe [] (\x -> ["desktop" .= x]) _desktop +++ maybe [] (\x -> ["fallback" .= x]) _fallback +++ maybe [] (\x -> ["icon" .= x]) _icon +++ maybe [] (\x -> ["tag" .= x]) _tag +++ []++defaultDesktop :: Desktop+defaultDesktop = Desktop+ { _desktop = Nothing+ , _fallback = Nothing+ , _icon = Nothing+ , _tag = Nothing++ }
+ Yesod/Goodies/PNotify/Modules/History.hs view
@@ -0,0 +1,71 @@+module Yesod.Goodies.PNotify.Modules.History+ ( History(..)+ , defaultHistory+ )where++import Data.Aeson+import Data.Text (Text)++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances++data Labels = Labels { _redisplay :: Maybe Text+ , _all :: Maybe Text+ , _last :: Maybe Text+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Labels where+ parseJSON (Object v) = Labels <$>+ v .:? "redisplay" <*>+ v .:? "all" <*>+ v .:? "last"++instance ToJSON Labels where+ toJSON (Labels { _redisplay+ , _all+ , _last+ })+ = object $ maybe [] (\x -> ["redisplay" .= x]) _redisplay +++ maybe [] (\x -> ["all" .= x]) _all +++ maybe [] (\x -> ["last" .= x]) _last +++ []++data History = History { _history :: Maybe Bool+ , _menu :: Maybe Bool+ , _fixed :: Maybe Bool+ , _maxonscreen :: Maybe Int+ , _labels :: Maybe Labels+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON History where+ parseJSON (Object v) = History <$>+ v .:? "history" <*>+ v .:? "menu" <*>+ v .:? "fixed" <*>+ v .:? "maxonscreen" <*>+ v .:? "labels"++instance ToJSON History where+ toJSON (History { _history+ , _menu+ , _fixed+ , _maxonscreen+ , _labels+ })+ = object $ maybe [] (\x -> ["history" .= x]) _history +++ maybe [] (\x -> ["menu" .= x]) _menu +++ maybe [] (\x -> ["fixed" .= x]) _fixed +++ maybe [] (\x -> ["maxonscreen" .= x]) _maxonscreen +++ maybe [] (\x -> ["labels" .= x]) _labels +++ []++defaultHistory :: History+defaultHistory = History+ { _history = Nothing+ , _menu = Nothing+ , _fixed = Nothing+ , _maxonscreen = Nothing+ , _labels = Nothing+ }
+ Yesod/Goodies/PNotify/Modules/Nonblock.hs view
@@ -0,0 +1,34 @@+module Yesod.Goodies.PNotify.Modules.Nonblock+ ( Nonblock(..)+ , defaultNonblock+ )where++import Data.Aeson+import Data.Text (Text)++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances++data Nonblock = Nonblock { _nonblock :: Maybe Bool+ , _nonblock_opacity :: Maybe Double+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Nonblock where+ parseJSON (Object v) = Nonblock <$>+ v .:? "nonblock" <*>+ v .:? "nonblock_opacity"++instance ToJSON Nonblock where+ toJSON (Nonblock { _nonblock+ , _nonblock_opacity+ })+ = object $ maybe [] (\x -> ["nonblock" .= x]) _nonblock +++ maybe [] (\x -> ["nonblock_opacity" .= x]) _nonblock_opacity +++ []++defaultNonblock :: Nonblock+defaultNonblock = Nonblock+ { _nonblock = Nothing+ , _nonblock_opacity = Nothing+ }
+ Yesod/Goodies/PNotify/Modules/Reference.hs view
@@ -0,0 +1,48 @@+module Yesod.Goodies.PNotify.Modules.Reference+ ( Reference(..)+ , defaultReference+ )where++import Data.Aeson+import Data.Text (Text)++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances++data Labels = Labels { _text :: Maybe Text+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Labels where+ parseJSON (Object v) = Labels <$>+ v .:? "text"++instance ToJSON Labels where+ toJSON (Labels { _text+ })+ = object $ maybe [] (\x -> ["text" .= x]) _text +++ []++data Reference = Reference { _putThing :: Maybe Bool+ , _labels :: Maybe Text+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Reference where+ parseJSON (Object v) = Reference <$>+ v .:? "putThing" <*>+ v .:? "labels"++instance ToJSON Reference where+ toJSON (Reference { _putThing+ , _labels+ })+ = object $ maybe [] (\x -> ["putThing" .= x]) _putThing +++ maybe [] (\x -> ["labels" .= x]) _labels +++ []++defaultReference :: Reference+defaultReference = Reference+ { _putThing = Nothing+ , _labels = Nothing+ }
+ Yesod/Goodies/PNotify/Modules/Stack.hs view
@@ -0,0 +1,134 @@+module Yesod.Goodies.PNotify.Modules.Stack+ ( Stack(..)+ , defaultStack+ )where+import Prelude hiding (Either(..))+import Data.Aeson+import Data.Text (Text)+import qualified Data.Text as T+import Control.Monad (mzero)++import Yesod.Goodies.PNotify.Types+import Yesod.Goodies.PNotify.Types.Instances+++data Dir = Up+ | Down+ | Right+ | Left+ deriving (Eq, Ord, Enum)++instance Read Dir where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "up" -> (Up, s')+ "down" -> (Down, s')+ "right" -> (Right, s')+ "left" -> (Left, s')+ _ -> error $ "invalid Dir " ++ v++instance Show Dir where+ show Up = "up"+ show Down = "down"+ show Right = "right"+ show Left = "left"++instance FromJSON Dir where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON Dir where+ toJSON Up = String "up"+ toJSON Down = String "down"+ toJSON Right = String "right"+ toJSON Left = String "left"++data Push = Top+ | Bottom+ deriving (Eq, Ord, Enum)++instance Read Push where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "top" -> (Top, s')+ "bottom" -> (Bottom, s')+ _ -> error $ "invalid Push " ++ v++instance Show Push where+ show Top = "top"+ show Bottom = "bottom"++instance FromJSON Push where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON Push where+ toJSON Top = String "top"+ toJSON Bottom = String "bottom"+++data Stack = Stack { _addpos2 :: Maybe Int+ , _animation :: Maybe Bool+ , _dir1 :: Maybe Dir+ , _dir2 :: Maybe Dir+ , _firstpos1 :: Maybe Int+ , _firstpos2 :: Maybe Int+ , _push :: Maybe Push+ , _spacing1 :: Maybe Int+ , _spacing2 :: Maybe Int+ , _context :: Maybe Text+ }+ deriving (Read, Show, Eq, Ord)++instance FromJSON Stack where+ parseJSON (Object v) = Stack <$>+ v .:? "addpos2" <*>+ v .:? "animation" <*>+ v .:? "dir1" <*>+ v .:? "dir2" <*>+ v .:? "firstpos1" <*>+ v .:? "firstpos2" <*>+ v .:? "push" <*>+ v .:? "spacing1" <*>+ v .:? "spacing2" <*>+ v .:? "context"++instance ToJSON Stack where+ toJSON (Stack { _addpos2+ , _animation+ , _dir1+ , _dir2+ , _firstpos1+ , _firstpos2+ , _push+ , _spacing1+ , _spacing2+ , _context+ })+ = object $ maybe [] (\x -> ["addpos2" .= x]) _addpos2 +++ maybe [] (\x -> ["animation" .= x]) _animation +++ maybe [] (\x -> ["dir1" .= x]) _dir1 +++ maybe [] (\x -> ["dir2" .= x]) _dir2 +++ maybe [] (\x -> ["firstpos1" .= x]) _firstpos1 +++ maybe [] (\x -> ["firstpos2" .= x]) _firstpos2 +++ maybe [] (\x -> ["push" .= x]) _push +++ maybe [] (\x -> ["spacing1" .= x]) _spacing1 +++ maybe [] (\x -> ["spacing2" .= x]) _spacing2 +++ maybe [] (\x -> ["context" .= x]) _context +++ []++defaultStack :: Stack+defaultStack = Stack+ { _addpos2 = Nothing+ , _animation = Nothing+ , _dir1 = Nothing+ , _dir2 = Nothing+ , _firstpos1 = Nothing+ , _firstpos2 = Nothing+ , _push = Nothing+ , _spacing1 = Nothing+ , _spacing2 = Nothing+ , _context = Nothing+ }
+ Yesod/Goodies/PNotify/Types.hs view
@@ -0,0 +1,28 @@+module Yesod.Goodies.PNotify.Types where++import Data.Text (Text)++type URL = Text++data NotifyType = Notice+ | Info+ | Success+ | Error+ deriving (Eq, Ord, Enum)++data NotifyStyling = JqueryUI+ | Bootstrap3+ | BrightTheme+ | FontAwesome+ deriving (Eq, Ord, Enum)++data AnimationType = None+ | Fade+ | Slide+ deriving (Eq, Ord, Enum)++data AnimateSpeed = Slow+ | Def+ | Normal+ | Fast+ deriving (Eq, Ord, Enum)
+ Yesod/Goodies/PNotify/Types/Instances.hs view
@@ -0,0 +1,119 @@+module Yesod.Goodies.PNotify.Types.Instances where++import Prelude hiding (Either(..))+import qualified Prelude as Prelude (Either(..))+import Control.Monad (mzero)+import Data.Aeson hiding (Result(..))+import Data.Text (Text)+import qualified Data.Text as T+import Yesod.Goodies.PNotify.Types++instance ToJSON (Prelude.Either Bool Text) where+ toJSON (Prelude.Left b) = Bool b+ toJSON (Prelude.Right t) = String t++instance FromJSON (Prelude.Either Bool Text) where+ parseJSON (Bool b) = Prelude.Left <$> parseJSON (Bool b)+ parseJSON (String t) = Prelude.Right <$> parseJSON (String t)+ parseJSON _ = mzero++instance Read NotifyType where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "notice" -> (Notice, s')+ "info" -> (Info, s')+ "success" -> (Success, s')+ "error" -> (Error, s')+ _ -> error $ "invalid NotifyType: " ++ v++instance Show NotifyType where+ show Notice = "notice"+ show Info = "info"+ show Success = "success"+ show Error = "error"++instance FromJSON NotifyType where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON NotifyType where+ toJSON Notice = String "notice"+ toJSON Info = String "info"+ toJSON Success = String "success"+ toJSON Error = String "error"++instance Read NotifyStyling where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "jqueryui" -> (JqueryUI, s')+ "bootstrap3" -> (Bootstrap3, s')+ "brighttheme" -> (BrightTheme, s')+ "fontawesome" -> (FontAwesome, s')+ _ -> error $ "invalid NotifyStyling: " ++ v++instance Show NotifyStyling where+ show JqueryUI = "jqueryui"+ show Bootstrap3 = "bootstrap3"+ show BrightTheme = "brighttheme"+ show FontAwesome = "fontawesome"++instance FromJSON NotifyStyling where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON NotifyStyling where+ toJSON JqueryUI = String "jqueryui"+ toJSON Bootstrap3 = String "bootstrap3"+ toJSON BrightTheme = String "brighttheme"+ toJSON FontAwesome = String "fontawesome"++instance Read AnimationType where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "none" -> (None, s')+ "fade" -> (Fade, s')+ "slide" -> (Slide, s')+ _ -> error $ "invalid AnimationType " ++ v++instance Show AnimationType where+ show None = "none"+ show Fade = "fade"+ show Slide = "slide"++instance FromJSON AnimationType where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON AnimationType where+ toJSON None = String "none"+ toJSON Fade = String "fade"+ toJSON Slide = String "slide"++instance Read AnimateSpeed where+ readsPrec d r = do+ (v, s') <- lex r+ return $ case v of+ "slow" -> (Slow, s')+ "def" -> (Def, s')+ "normal" -> (Normal, s')+ "fast" -> (Fast, s')+ _ -> error $ "invalid AnimationType " ++ v++instance Show AnimateSpeed where+ show Slow = "slow"+ show Def = "def"+ show Normal = "normal"+ show Fast = "fast"++instance FromJSON AnimateSpeed where+ parseJSON (String v) = return $ read $ T.unpack v+ parseJSON _ = mzero++instance ToJSON AnimateSpeed where+ toJSON Slow = String "slow"+ toJSON Def = String "def"+ toJSON Normal = String "normal"+ toJSON Fast = String "fast"
yesod-pnotify.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yesod-pnotify-version: 1.1.0+version: 1.1.1 synopsis: Yet another getMessage/setMessage using pnotify jquery plugins description: Yet another getMessage/setMessage using pnotify jquery plugins homepage: https://github.com/cutsea110/yesod-pnotify@@ -17,6 +17,15 @@ library exposed-modules: Yesod.Goodies.PNotify+ Yesod.Goodies.PNotify.Types+ Yesod.Goodies.PNotify.Types.Instances+ Yesod.Goodies.PNotify.Modules.Buttons+ Yesod.Goodies.PNotify.Modules.Confirm+ Yesod.Goodies.PNotify.Modules.Desktop+ Yesod.Goodies.PNotify.Modules.History+ Yesod.Goodies.PNotify.Modules.Nonblock+ Yesod.Goodies.PNotify.Modules.Reference+ Yesod.Goodies.PNotify.Modules.Stack -- other-modules: