diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 diff --git a/digestive-functors-heist.cabal b/digestive-functors-heist.cabal --- a/digestive-functors-heist.cabal +++ b/digestive-functors-heist.cabal @@ -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 diff --git a/src/Text/Digestive/Heist.hs b/src/Text/Digestive/Heist.hs --- a/src/Text/Digestive/Heist.hs +++ b/src/Text/Digestive/Heist.hs @@ -39,6 +39,7 @@ , dfInputSelectGroup , dfInputRadio , dfInputCheckbox + , dfInputFile , dfInputSubmit , dfLabel , dfForm diff --git a/src/Text/Digestive/Heist/Compiled.hs b/src/Text/Digestive/Heist/Compiled.hs --- a/src/Text/Digestive/Heist/Compiled.hs +++ b/src/Text/Digestive/Heist/Compiled.hs @@ -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 :: 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 :: 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 @@ -- > -- -- 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. +-- +-- > +-- > Content to be rendered if there are any errors... +-- > +-- +-- 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 :: 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 "
" + , template + , body + , yieldPureText "
" + ] 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