document.write('
Data hosted with ♥ by Pastebin.com - Download Raw - See Original
  1. {-# LANGUAGE OverloadedStrings #-}
  2. module Splices where
  3.  
  4. import Snap.Snaplet.Heist.Interpreted
  5. import Heist
  6. import Heist.Interpreted
  7. import qualified Text.XmlHtml as X
  8. import Application
  9. import Data.List (find)
  10.  
  11. -- <if><condition>
  12. -- <then>content if condition is true</then>
  13. -- <else>content if condition is false</else>
  14. -- </if>
  15. -- available conditions: equal, not (or not equal ...)
  16. ifSplice :: SnapletISplice App
  17. ifSplice = do
  18.   nodes <- runChildrenWith [("equal", equalSplice), ("not", notSplice)]
  19.   if null nodes
  20.     then return []
  21.     else case (head nodes) of
  22.       X.TextNode t -> if t == "1" then returnThenNode nodes else returnElseNode nodes
  23.       _            -> return [X.TextNode "Element w <if> musi być równy 1 lub 0"]
  24.   where
  25.     returnThenNode [] = return [X.TextNode "Brakuje elementu <then></then>"]
  26.     returnThenNode l = return $ case find isThenNode l of
  27.       Just (X.Element _ _ c) -> c
  28.       _ -> [X.TextNode "Brakuje elementu <then></then>"]
  29.     returnElseNode [] = return [X.TextNode "Brakuje elementu <else></else>"]
  30.     returnElseNode l = return $ case find isElseNode l of
  31.       Just (X.Element _ _ c) -> c
  32.       _ -> [X.TextNode "Brakuje elementu <else></else>"]
  33.     isThenNode (X.Element "then" _ _) = True
  34.     isThenNode _ = False
  35.     isElseNode (X.Element "else" _ _) = True
  36.     isElseNode _ = False
  37.  
  38. -- <equal a="" b=""/>
  39. equalSplice :: SnapletISplice App
  40. equalSplice = do
  41.   (X.Element _ attrs _) <- getParamNode
  42.   let a = find (\\(n,_) -> n == "a") attrs
  43.       b = find (\\(n,_) -> n == "b") attrs
  44.   case a of
  45.     Nothing -> return [X.TextNode "Element <equal> musi posiadać atrybut a"]
  46.     Just (_,aa) -> case b of
  47.       Nothing -> return [X.TextNode "Element <equal> musi posiadać atrybut b"]
  48.       Just (_,bb) -> if aa == bb
  49.         then return [X.TextNode "1"]
  50.         else return [X.TextNode "0"]
  51.  
  52. -- <not>0/1</not>
  53. notSplice :: SnapletISplice App
  54. notSplice = do
  55.   c <- runChildren
  56.   if length c /= 1
  57.     then return [X.TextNode "Element <not> może przyjmować tylko 1 element wartości 0 lub 1"]
  58.     else case head c of
  59.       X.TextNode t -> if t == "1"
  60.         then return [X.TextNode "0"]
  61.         else return [X.TextNode "1"]
  62.       _ -> return [X.TextNode "Element <not> może przyjmować tylko wartości 0 lub 1"]
');