digestive-functors-heist 0.8.5.0 → 0.8.6.0
raw patch · 4 files changed
+119/−43 lines, 4 filesdep ~mtl
Dependency ranges changed: mtl
Files
- CHANGELOG +6/−0
- digestive-functors-heist.cabal +2/−2
- src/Text/Digestive/Heist.hs +1/−0
- src/Text/Digestive/Heist/Compiled.hs +110/−41
CHANGELOG view
@@ -1,2 +1,8 @@+- 0.8.6.0+ * Make the dfIfChildErrors splice run its children+ * Allow dfListItem to be used multiple times+ * Add noTemplate attribute to dfListItem+ * Add dfValue and dfIfNoChildErrors+ - 0.8.5.0 * Support disabling in compiled heist
digestive-functors-heist.cabal view
@@ -1,5 +1,5 @@ Name: digestive-functors-heist-Version: 0.8.5.0+Version: 0.8.6.0 Synopsis: Heist frontend for the digestive-functors library Description: Heist frontend for the digestive-functors library Homepage: http://github.com/jaspervdj/digestive-functors@@ -26,6 +26,6 @@ blaze-builder >= 0.3 && < 0.4, digestive-functors >= 0.6.1 && < 0.8, heist >= 0.13 && < 0.14,- mtl >= 2 && < 2.2,+ mtl >= 2 && < 2.3, text >= 0.11 && < 1.2, xmlhtml >= 0.1 && < 0.3
src/Text/Digestive/Heist.hs view
@@ -39,6 +39,7 @@ , dfInputSelectGroup , dfInputRadio , dfInputCheckbox+ , dfInputFile , dfInputSubmit , dfLabel , dfForm
src/Text/Digestive/Heist/Compiled.hs view
@@ -42,6 +42,7 @@ , dfInputSelectGroup , dfInputRadio , dfInputCheckbox+ , dfInputFile , dfInputSubmit , dfLabel , dfErrorList@@ -57,19 +58,18 @@ -------------------------------------------------------------------------------- import Blaze.ByteString.Builder import Control.Monad (mplus)+import Control.Monad.Trans (MonadIO, liftIO) import Data.Function (on) import Data.List (unionBy)-import Data.Maybe (fromMaybe)-import Data.Monoid (mappend, mempty, (<>))+import Data.Monoid (mappend, mconcat, mempty, (<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding import Heist import Heist.Compiled import Heist.Compiled.LowLevel+import Text.Printf import qualified Text.XmlHtml as X-- ------------------------------------------------------------------------------ import Text.Digestive.Form.List import Text.Digestive.View@@ -79,11 +79,12 @@ -- | List of splices defined for forms. For most uses the formSplice function -- will be fine and you won't need to use this directly. But this is -- available if you need more customization.-digestiveSplices :: (Monad m)+digestiveSplices :: (MonadIO m) => RuntimeSplice m (View Text) -> Splices (Splice m) digestiveSplices vp = do "dfInput" ## dfInput vp+ "dfValue" ## dfValue vp "dfInputText" ## dfInputText vp "dfInputTextArea" ## dfInputTextArea vp "dfInputPassword" ## dfInputPassword vp@@ -99,6 +100,7 @@ "dfChildErrorList" ## dfChildErrorList vp "dfSubView" ## dfSubView vp "dfIfChildErrors" ## dfIfChildErrors vp+ "dfIfNoChildErrors" ## dfIfNoChildErrors vp "dfInputList" ## dfInputList vp "dfEncType" ## dfEncType vp @@ -113,7 +115,7 @@ -- -- Then you can use the customerForm tag just like you would use the dfForm -- tag in interpreted templates anywhere you want to have a customer form.-formSplice :: Monad m+formSplice :: MonadIO m => Splices (Splice m) -- ^ Extra splices that you want to have available inside the -- form tag.@@ -127,15 +129,15 @@ ------------------------------------------------------------------------------ -- | Same as 'formSplice' except the supplied splices and attribute -- splices are applied to the resulting form view.-formSplice' :: Monad m+formSplice' :: MonadIO m => (RuntimeSplice m (View Text) -> Splices (Splice m)) -> (RuntimeSplice m (View Text) -> Splices (AttrSplice m)) -> RuntimeSplice m (View Text) -> Splice m formSplice' ss as = deferMap return $ \getView -> do node <- getParamNode- let (_, attrs) = getRefAttributes node Nothing- tree = X.Element "form"+ (_, attrs) <- getRefAttributes node (Just "")+ let tree = X.Element "form" (addAttrs attrs [ ("method", "POST") , ("enctype", "${dfEncType}")@@ -158,16 +160,35 @@ ---------------------------------------------------------------------------------getRefAttributes :: X.Node- -> Maybe Text -- ^ Optional default ref- -> (Text, [(Text, Text)]) -- ^ (Ref, other attrs)-getRefAttributes node defaultRef =+getRefAttributes+ :: MonadIO m+ => X.Node+ -> Maybe Text -- ^ Optional default ref+ -> HeistT n m (Text, [(Text, Text)])+getRefAttributes node defaultRef = do+ tfp <- getTemplateFilePath+ getRefAttributes' tfp node defaultRef+++--------------------------------------------------------------------------------+getRefAttributes'+ :: MonadIO m+ => Maybe FilePath+ -> X.Node+ -> Maybe Text -- ^ Optional default ref+ -> m (Text, [(Text, Text)])+getRefAttributes' tfp node defaultRef = do+ let end s = do+ liftIO $ putStrLn s+ return ("", []) case node of- X.Element _ as _ ->- let ref = fromMaybe (error $ show node ++ ": missing ref") $- lookup "ref" as `mplus` defaultRef- in (ref, filter ((/= "ref") . fst) as)- _ -> (error "Wrong type of node!", [])+ X.Element n as _ -> do+ case lookup "ref" as `mplus` defaultRef of+ Nothing -> end $ printf "%s: missing ref, path %s"+ (T.unpack n) (show tfp)+ Just ref -> return (ref, filter ((/= "ref") . fst) as)+ _ ->+ end $ "Wrong type of node! (" ++ show node ++ ")" dfEncType :: (Monad m)@@ -184,7 +205,7 @@ -> RuntimeSplice m (View v) -> Splice m dfMaster f getView = do node <- getParamNode- let (ref, attrs) = getRefAttributes node Nothing+ (ref, attrs) <- getRefAttributes node Nothing runAttrs <- runAttributesRaw attrs return $ yieldRuntime $ do view <- getView@@ -221,7 +242,7 @@ dfInputSubmit :: Monad m => Splice m dfInputSubmit = do node <- getParamNode- let (_, attrs) = getRefAttributes node Nothing+ (_, attrs) <- getRefAttributes node (Just "") runAttrs <- runAttributesRaw attrs return $ yieldRuntime $ do attrs' <- runAttrs@@ -238,7 +259,7 @@ dfLabel :: Monad m => RuntimeSplice m (View v) -> Splice m dfLabel getView = do node <- getParamNode- let (ref, attrs) = getRefAttributes node Nothing+ (ref, attrs) <- getRefAttributes node Nothing runAttrs <- runAttributesRaw attrs return $ yieldRuntime $ do view <- getView@@ -392,13 +413,14 @@ -- -- > <dfErrorList ref="user.name" /> -- > <dfInputText ref="user.name" />-dfErrorList :: Monad m => RuntimeSplice m (View Text) -> Splice m+dfErrorList :: MonadIO m => RuntimeSplice m (View Text) -> Splice m dfErrorList getView = do node <- getParamNode+ tfp <- getTemplateFilePath return $ yieldRuntime $ do view <- getView- let (ref, attrs) = getRefAttributes node Nothing- nodes = errorList (errors ref view) attrs+ (ref, attrs) <- getRefAttributes' tfp node Nothing+ let nodes = errorList (errors ref view) attrs return $ X.renderHtmlFragment X.UTF8 nodes @@ -415,13 +437,14 @@ -- Which is more conveniently written as: -- -- > <dfChildErrorList />-dfChildErrorList :: Monad m => RuntimeSplice m (View Text) -> Splice m+dfChildErrorList :: MonadIO m => RuntimeSplice m (View Text) -> Splice m dfChildErrorList getView = do node <- getParamNode+ tfp <- getTemplateFilePath return $ yieldRuntime $ do view <- getView- let (ref, attrs) = getRefAttributes node (Just "")- nodes = errorList (childErrors ref view) attrs+ (ref, attrs) <- getRefAttributes' tfp node (Just "")+ let nodes = errorList (childErrors ref view) attrs return $ X.renderHtmlFragment X.UTF8 nodes @@ -434,18 +457,42 @@ -- > </dfIfChildErrors> -- -- The @ref@ attribute can be omitted if you want to check the entire form.-dfIfChildErrors :: (Monad m) => RuntimeSplice m (View v) -> Splice m+dfIfChildErrors :: (MonadIO m) => RuntimeSplice m (View v) -> Splice m dfIfChildErrors getView = do node <- getParamNode+ childrenChunks <- runChildren+ tfp <- getTemplateFilePath return $ yieldRuntime $ do view <- getView- let (ref, _) = getRefAttributes node $ Just ""+ (ref, _) <- getRefAttributes' tfp node $ Just "" if null (childErrors ref view) then return mempty- else return $ X.renderHtmlFragment X.UTF8 (X.childNodes node)+ else codeGen childrenChunks --------------------------------------------------------------------------------+-- | Render some content only if there are any errors. This is useful for markup+-- purposes.+--+-- > <dfIfNoChildErrors ref="user">+-- > Content to be rendered if there are any errors...+-- > </dfIfNoChildErrors>+--+-- The @ref@ attribute can be omitted if you want to check the entire form.+dfIfNoChildErrors :: (MonadIO m) => RuntimeSplice m (View v) -> Splice m+dfIfNoChildErrors getView = do+ node <- getParamNode+ childrenChunks <- runChildren+ tfp <- getTemplateFilePath+ return $ yieldRuntime $ do+ view <- getView+ (ref, _) <- getRefAttributes' tfp node $ Just ""+ if null (childErrors ref view)+ then codeGen childrenChunks+ else return mempty+++-------------------------------------------------------------------------------- -- | This splice allows reuse of templates by selecting some child of a form -- tree. While this may sound complicated, it's pretty straightforward and -- practical. Suppose we have:@@ -469,21 +516,30 @@ -- > </dfSubView> -- > -- > <dfInputTextArea ref="comment.body" />-dfSubView :: Monad m => RuntimeSplice m (View Text) -> Splice m+dfSubView :: MonadIO m => RuntimeSplice m (View Text) -> Splice m dfSubView getView = do node <- getParamNode p2 <- newEmptyPromise+ tfp <- getTemplateFilePath let action = yieldRuntimeEffect $ do view <- getView- let (ref, _) = getRefAttributes node Nothing- view' = subView ref view+ (ref, _) <- getRefAttributes' tfp node Nothing+ let view' = subView ref view putPromise p2 view' res <- withLocalSplices (digestiveSplices (getPromise p2)) noSplices $ runNodeList $ X.childNodes node return $ action <> res -dfSingleListItem :: Monad n+------------------------------------------------------------------------------+-- | Splice that expands to a field's value.+dfValue :: Monad m => RuntimeSplice m (View v) -> Splice m+dfValue = dfMaster $ \ref _ view -> do+ let !value = fieldInputText ref view+ return $ fromByteString $ encodeUtf8 value+++dfSingleListItem :: MonadIO n => X.Node -> (RuntimeSplice n (View Text) -> AttrSplice n) -> RuntimeSplice n (View Text)@@ -508,7 +564,11 @@ -- Splices: -- dfListItem - This tag must surround the markup for a single list item. -- It surrounds all of its children with a div with id \"foo.items\" and--- class \"inputList\".+-- class \"inputList\" and displays a copy for each of the list items+-- including a \"template\" item used for generating new items. If the+-- you supply the attribute \"noTemplate\", then the template item is not+-- included and the generated list will not be dynamically updated by the+-- add and remove actions. -- -- Attribute Splices: -- itemAttrs - Attribute you should use on div, span, etc that surrounds all@@ -520,25 +580,26 @@ -- an onclick attribute that calls a javascript function addInputListItem. -- removeControl - Use this attribute on the control for removing individual -- items. It adds an onclick attribute that calls removeInputListItem.-dfInputList :: Monad m => RuntimeSplice m (View Text) -> Splice m+dfInputList :: MonadIO m => RuntimeSplice m (View Text) -> Splice m dfInputList getView = do node <- getParamNode itemsPromise <- newEmptyPromise refPromise <- newEmptyPromise indicesPromise <- newEmptyPromise templateViewPromise <- newEmptyPromise+ tfp <- getTemplateFilePath let itemAttrs gv _ = do view <- gv listRef <- getPromise refPromise return- [ ("id", T.concat [listRef, ".", last $ "0" : viewContext view])+ [ ("data-ind", T.concat [listRef, ".", last $ "0" : viewContext view]) , ("class", T.append listRef ".inputListItem") ] templateAttrs gv _ = do view <- gv listRef <- getPromise refPromise return- [ ("id", T.concat [listRef, ".", last $ "-1" : viewContext view])+ [ ("data-ind", T.concat [listRef, ".", last $ "-1" : viewContext view]) , ("class", T.append listRef ".inputListTemplate") , ("style", "display: none;") ]@@ -547,7 +608,15 @@ template <- dfSingleListItem n templateAttrs (getPromise templateViewPromise) body <- deferMany (dfSingleListItem n itemAttrs) $ getPromise itemsPromise- return $ template <> body+ return $ if X.hasAttribute "noTemplate" n+ then body+ -- The inputListInstance class control dynamic update. If we're+ -- not displaying a template, then we can't dynamically update.+ else mconcat [ yieldPureText "<div class=\"inputListInstance\">"+ , template+ , body+ , yieldPureText "</div>"+ ] let listAttrs = [ ("id", "${dfListRef}") , ("class", "inputList")@@ -579,8 +648,8 @@ -- The runtime action that gets the right data and puts it in promises. let action = yieldRuntimeEffect $ do view <- getView- let (ref, _) = getRefAttributes node Nothing- listRef = absoluteRef ref view+ (ref, _) <- getRefAttributes' tfp node Nothing+ let listRef = absoluteRef ref view items = listSubViews ref view tview = makeListSubView ref (-1) view putPromise refPromise listRef