packages feed

snap-extras 0.6 → 0.7

raw patch · 7 files changed

+67/−64 lines, 7 filesdep ~digestive-functors-heistdep ~heistdep ~snap

Dependency ranges changed: digestive-functors-heist, heist, snap

Files

snap-extras.cabal view
@@ -1,5 +1,5 @@ Name:                snap-extras-Version:             0.6+Version:             0.7 Synopsis:            A collection of useful helpers and utilities for Snap web applications. Description:         This package contains a collection of helper functions                      that come in handy in most practical, real-world@@ -47,16 +47,16 @@     , containers               >= 0.3   && < 0.6     , data-default             >= 0.5   && < 0.6     , digestive-functors       >= 0.3   && < 0.7-    , digestive-functors-heist >= 0.5.2 && < 0.8+    , digestive-functors-heist >= 0.8   && < 0.9     , digestive-functors-snap  >= 0.3   && < 0.7     , directory-tree           >= 0.10  && < 0.12     , errors                   >= 1.4   && < 1.5     , filepath                 >= 1.1   && < 1.4-    , heist                    >= 0.12  && < 0.13+    , heist                    >= 0.13  && < 0.14     , mtl                      >= 2.0   && < 2.2     , readable                 >= 0.1   && < 0.2     , safe                     >= 0.3   && < 0.4-    , snap                     >= 0.10  && < 0.13+    , snap                     >= 0.13  && < 0.14     , snap-core                >= 0.7   && < 0.10     , text                     >= 0.11  && < 0.12     , transformers             >= 0.2   && < 0.4
src/Snap/Extras/FlashNotice.hs view
@@ -36,8 +36,8 @@     :: HasHeist b      => Snaplet (Heist b) -> SnapletLens b SessionManager -> Initializer b v () initFlashNotice h session = do-    let splices = [ ("flash", flashSplice session) ]-        csplices = [ ("flash", flashCSplice session) ]+    let splices = ("flash" ## flashSplice session)+        csplices = ("flash" ## flashCSplice session)     addConfig h $ mempty { hcCompiledSplices = csplices                          , hcInterpretedSplices = splices } @@ -72,16 +72,17 @@ -- Ex: <flash type='success'/> flashSplice :: SnapletLens b SessionManager -> SnapletISplice b flashSplice session = do-  typ <- liftM (getAttribute "type") getParamNode-  let typ' = maybe "warning" id typ-  let k = T.concat ["_", typ']-  msg <- lift $ withTop session $ getFromSession k-  case msg of -    Nothing -> return []-    Just msg' -> do-      lift $ withTop session $ deleteFromSession k >> commitSession-      callTemplateWithText "_flash"-           [ ("type", typ') , ("message", msg') ]+    typ <- liftM (getAttribute "type") getParamNode+    let typ' = maybe "warning" id typ+    let k = T.concat ["_", typ']+    msg <- lift $ withTop session $ getFromSession k+    case msg of +      Nothing -> return []+      Just msg' -> do+        lift $ withTop session $ deleteFromSession k >> commitSession+        callTemplateWithText "_flash" $ do+             "type" ## typ'+             "message" ## msg'   -------------------------------------------------------------------------------@@ -94,20 +95,22 @@     n <- getParamNode     let typ = maybe "warning" id $ getAttribute "type" n         k = T.concat ["_", typ]-        splice prom = do-            flashTemplate <- C.withLocalSplices-              [ ("type", return $ C.yieldPureText typ)-              , ("message", return $ C.yieldRuntimeText $ liftM fromJust-                                   $ C.getPromise prom) ]-              [] (C.callTemplate "_flash")-            return $ C.yieldRuntime $ do-                msg <- C.getPromise prom-                case msg of-                  Nothing -> return mempty-                  Just _ -> do-                    lift $ withTop session $-                      deleteFromSession k >> commitSession-                    C.codeGen flashTemplate-    C.defer splice (lift $ withTop session $ getFromSession k)+        getVal = lift $ withTop session $ getFromSession k+        ss = do+          "type" ## return $ C.yieldPureText typ+          "message" ## return $ C.yieldRuntimeText+                              $ liftM (fromMaybe "Flash notice cookie error")+                                getVal+    flashTemplate <- C.withLocalSplices ss noSplices (C.callTemplate "_flash")+    return $ C.yieldRuntime $ do+        msg <- getVal+        case msg of+          Nothing -> return mempty+          Just _ -> do+            res <- C.codeGen flashTemplate+            lift $ withTop session $ do+              deleteFromSession k+              commitSession+            return res
src/Snap/Extras/NavTrails.hs view
@@ -128,12 +128,12 @@ addNavTrailSplices heist = do   lens <- getLens   addConfig heist $-    mempty { hcCompiledSplices =-               [ ("linkToFocus", focusCSplice lens)-               , ("linkToBack", backCSplice) ]-           , hcInterpretedSplices =-               [ ("linkToFocus", focusSplice lens)-               , ("linkToBack", backSplice) ]+    mempty { hcCompiledSplices = do+               "linkToFocus" ## focusCSplice lens+               "linkToBack" ## backCSplice+           , hcInterpretedSplices = do+               "linkToFocus" ## focusSplice lens+               "linkToBack" ## backSplice            }
src/Snap/Extras/SpliceUtils/Common.hs view
@@ -10,7 +10,7 @@ getScripts d = do     tree <- liftIO $ build d     let files = F.foldMap ((:[]) . fst) $ zipPaths $ "" :/ free tree-    return $ filter visibleScripts files+    return $ sort $ filter visibleScripts files   where     visibleScripts fname =         isSuffixOf ".js" fname && not (isPrefixOf "_" (takeFileName fname))
src/Snap/Extras/SpliceUtils/Compiled.hs view
@@ -6,7 +6,6 @@ import           Blaze.ByteString.Builder.ByteString import           Control.Monad.Trans import           Data.Monoid-import           Data.Text                 (Text) import qualified Data.Text                 as T import qualified Data.Text.Encoding        as T import           Snap.Core@@ -17,10 +16,10 @@ -------------------------------------------------------------------------------  -utilSplices :: MonadSnap m => [(Text, Splice m)]-utilSplices = [ ("rqparam", paramSplice)-              , ("refererLink", refererCSplice)-              ]+utilSplices :: MonadSnap m => Splices (Splice m)+utilSplices = do+    "rqparam" ## paramSplice+    "refererLink" ## refererCSplice   refererCSplice :: MonadSnap m => Splice m
src/Snap/Extras/SpliceUtils/Interpreted.hs view
@@ -30,11 +30,10 @@  ------------------------------------------------------------------------------- -- | A list of splices offered in this module-utilSplices :: [(Text, SnapletISplice b)]-utilSplices =-  [ ("rqparam", paramSplice)-  , ("refererLink", refererSplice)-  ]+utilSplices :: Splices (SnapletISplice b)+utilSplices = do+  "rqparam" ## paramSplice+  "refererLink" ## refererSplice   refererSplice :: MonadSnap m => Splice m@@ -64,7 +63,7 @@ -- -- > heistLocal runTextAreas $ render "joo/index" runTextAreas :: Monad m => HeistState m -> HeistState m-runTextAreas = bindSplices [ ("textarea", ta)]+runTextAreas = bindSplices ("textarea" ## ta)  where    ta = do      hs <- getHS@@ -91,15 +90,17 @@     -- ^ Default value     -> Splice m selectSplice nm fid xs defv =-    callTemplate "_select"-      [("options", opts), ("name", textSplice nm), ("id", textSplice fid)]+    callTemplate "_select" $ do+      "options" ## opts+      "name" ## textSplice nm+      "id" ## textSplice fid     where       opts = mapSplices gen xs-      gen (val,txt) = runChildrenWith-        [ ("val", textSplice val)-        , ("text", textSplice txt)-        , ("ifSelected", ifISplice $ maybe False (== val) defv)-        , ("ifNotSelected", ifISplice $ maybe True (/= val) defv) ]+      gen (val,txt) = runChildrenWith $ do+        "val" ## textSplice val+        "text" ## textSplice txt+        "ifSelected" ## ifISplice $ maybe False (== val) defv+        "ifNotSelected" ## ifISplice $ maybe True (/= val) defv   ------------------------------------------------------------------------------
src/Snap/Extras/Tabs.hs view
@@ -43,8 +43,8 @@ ------------------------------------------------------------------------------- initTabs :: HasHeist b => Snaplet (Heist b) -> Initializer b v () initTabs h = do-    let splices = [ ("tabs", tabsSplice) ]-        csplices = [ ("tabs", tabsCSplice) ]+    let splices = ("tabs" ## tabsSplice)+        csplices = ("tabs" ## tabsCSplice)     addConfig h $ mempty { hcCompiledSplices = csplices                          , hcInterpretedSplices = splices } @@ -60,9 +60,9 @@ tabsCSplice = do     n <- getParamNode     let getCtx = lift $ (T.decodeUtf8 . rqURI) `liftM` getRequest-        splices = [("tab", C.defer tabCSplice getCtx)]+        splices = ("tab" ## tabCSplice getCtx)     case n of-      Element _ attrs ch -> C.withLocalSplices splices [] $+      Element _ attrs ch -> C.withLocalSplices splices noSplices $           C.runNode $ X.Element "ul" attrs ch       _ -> error "tabs tag has to be an Element" @@ -70,8 +70,8 @@ ------------------------------------------------------------------------------ -- | Can't use tabSpliceWorker because we have to explicitly run the -- attributes in order to get ${} splice substitution.-tabCSplice :: Monad m => C.Promise Text -> C.Splice m-tabCSplice promise = do+tabCSplice :: Monad m => RuntimeSplice m Text -> C.Splice m+tabCSplice getCtx = do     (Element _ attrs ch) <- getParamNode     attrsAction <- C.runAttributesRaw attrs     let ps as context = do@@ -85,7 +85,7 @@             _ -> Left "Unknown match type"           return (url, ch, m')     return $ C.yieldRuntime $ do-        ctx <- C.getPromise promise+        ctx <- getCtx         as <- attrsAction         let res = case ps as ctx of               Left e -> error $ "Tab error: " ++ e@@ -122,7 +122,7 @@ tabsSplice :: MonadSnap m => Splice m tabsSplice = do   context <- lift $ (T.decodeUtf8 . rqURI) `liftM` getRequest-  let bind = bindSplices [("tab", tabSplice context)]+  let bind = bindSplices ("tab" ## tabSplice context)   n <- getParamNode   case n of     Element _ attrs ch -> localHS bind $ runNodeList [X.Element "ul" attrs ch]