packages feed

xmlbf 0.1 → 0.2

raw patch · 4 files changed

+60/−53 lines, 4 files

Files

ChangeLog.md view
@@ -1,3 +1,11 @@+# 0.2++* 'Text' constructor hidden in favor of a 'text' function plus a 'Text' pattern+  synonym, just like with 'element' and 'Element'.++* Documentation: Render 'Element' pattern synonym.++ # 0.1  * First version.
lib/Xmlbf.hs view
@@ -16,8 +16,7 @@ -- 'Parser' type and the related tools. -- -- @xmlbf@ provides a 'ToXml' class intended to be used as the familiar--- 'Data.Aeson.toJSON' from the @aeson@ package. This relies on the--- 'Node' and 'Element'' types.+-- 'Data.Aeson.toJSON' from the @aeson@ package. -- -- @xmlb@ provides tools like 'df' and 'dfM' for finding a fixpoint -- of a XML structure.@@ -37,9 +36,14 @@  , ToXml(toXml)  , encode - , Node(Text, Element)+ , Node++ , pattern Element  , element + , pattern Text+ , text+    -- * Fixpoints  , df  , dfM@@ -65,29 +69,41 @@  -------------------------------------------------------------------------------- --- | Either a text or an element node in an XML fragment. Construct with either--- 'Text' or 'element', respectively.+-- | Either a text or an element node in an XML fragment.+--+-- Construct with 'text' or 'element'. Destruct with 'Text' or 'Element'. data Node   = Element' !T.Text !(HM.HashMap T.Text T.Text) ![Node]-  | Text !T.Text+  | Text' !T.Text   deriving (Eq, Show) +-- | Destruct an element 'Node'. pattern Element :: T.Text -> (HM.HashMap T.Text T.Text) -> [Node] -> Node pattern Element t as cs <- Element' t as cs +-- | Destruct a text 'Node'.+pattern Text :: T.Text -> Node+pattern Text t <- Text' t+ -- | Constructs a 'Text'. instance IsString Node where-  fromString = Text . T.pack+  fromString = text . T.pack   {-# INLINABLE fromString #-}  -- | Concats 'Text's together. normalize :: [Node] -> [Node] {-# INLINE normalize #-} normalize = \case-   Text a : Text b : ns -> normalize (Text (a <> b) : ns)+   Text a : Text b : ns -> normalize (text (a <> b) : ns)    (n : ns) -> n : normalize ns    [] -> [] +-- | Construct a text 'Node'.+text :: T.Text -> Node+text = Text'+{-# INLINE text #-}++-- | Construct an element 'Node'. element   :: T.Text   -- ^ Element' name.@@ -102,8 +118,8 @@   -- TODO: We just check for emptyness currently. element t0 hm0 ns0 = do   guarde (t0 == T.strip t0) $-     "Element' name has surrounding whitespace: " ++ show t0-  guarde (not (T.null t0)) ("Element' name is blank: " ++ show t0)+     "Element name has surrounding whitespace: " ++ show t0+  guarde (not (T.null t0)) ("Element name is blank: " ++ show t0)   for_ (HM.keys hm0) $ \k -> do      guarde (k == T.strip k) $         "Attribute name has surrounding whitespace: " ++ show k@@ -191,10 +207,10 @@ -- Consumes the element from the parser state. pElement :: T.Text -> Parser a -> Parser a pElement t0 p0 = Parser $ \case-  SReg t as (Element' t' as' cs' : cs) | t == t0 ->  do+  SReg t as (Element t' as' cs' : cs) | t == t0 ->  do     (a,_) <- unParser p0 (SReg t' as' cs')     Right (a, SReg t as cs)-  STop (Element' t as cs : ns) | t == t0 -> do+  STop (Element t as cs : ns) | t == t0 -> do     (a,_) <- unParser p0 (SReg t as cs)     Right (a, STop ns)   _ -> Left ("Missing element " ++ show t0)@@ -277,7 +293,7 @@ encode :: [Node] -> BB.Builder encode xs = mconcat $ xs >>= \case   Text x -> [encodeXmlUtf8 x]-  Element' t as cs ->+  Element t as cs ->     [ "<"     , encodeUtf8 t     , mconcat $ do@@ -315,9 +331,9 @@ -- @ -- foo :: 'Node' -> ['Node'] -- foo = 'df' $ \\k -> \\case---     'Element'' "w" as cs -> k ('Element'' "x" as cs)---     'Element'' "x" as cs -> ['Element'' "y" as cs]---     'Element'' "y" as cs -> k ('Element'' "z" as cs)+--     'Element' "w" as cs -> let 'Right' e = 'element' "x" as cs in k e+--     'Element' "x" as cs -> let 'Right' e = 'element' "y" as cs in [e]+--     'Element' "y" as cs -> let 'Right' e = 'element' "z" as cs in k e -- @ -- -- /WARNING/ If you call @k@ in every branch, then 'df' will never terminate.@@ -361,7 +377,7 @@ {-# INLINE traverschildren #-} traverschildren f c0 = case _cursorCurrent c0 of   Text _ -> pure c0-  Element' t as cs -> do+  Element t as cs -> do      n1s <- fmap (normalize . join) (traverse f cs)      pure (c0 {_cursorCurrent = Element' t as n1s})
test/Test.hs view
@@ -81,15 +81,15 @@       bsEncode [n0] @?= "<x a=\"y\" b=\"z\"/>"    , HU.testCase "<x a=\"y\" b=\"z\"></x>" $ do-      let n0 = unsafeElement "x" [("a","y"), ("b","z")] [X.Text ""]+      let n0 = unsafeElement "x" [("a","y"), ("b","z")] [X.text ""]       bsEncode [n0] @?= "<x a=\"y\" b=\"z\"></x>"    , HU.testCase "<x>foo</x>" $ do-      let n0 = unsafeElement "x" [] [X.Text "foo"]+      let n0 = unsafeElement "x" [] [X.text "foo"]       bsEncode [n0] @?= "<x>foo</x>"    , HU.testCase "<x>foobar</x>" $ do-      let n0 = unsafeElement "x" [] [X.Text "foo", X.Text "bar"]+      let n0 = unsafeElement "x" [] [X.text "foo", X.text "bar"]       bsEncode [n0] @?= "<x>foobar</x>"    , HU.testCase "<x><y/></x>" $ do@@ -98,7 +98,7 @@    , HU.testCase "<x><y/></x>" $ do       let n0 = unsafeElement "x" []-                  [X.Text "", unsafeElement "y" [] [], X.Text ""]+                  [X.text "", unsafeElement "y" [] [], X.text ""]       bsEncode [n0] @?= "<x><y/></x>"    , HU.testCase "<x><y/><z/></x>" $ do@@ -120,7 +120,7 @@       Right () @=? X.runParser X.pEndOfInput []    , HU.testCase "endOfInput: Not end of input yet" $ do-      Left "Not end of input yet" @=? X.runParser X.pEndOfInput [X.Text "&"]+      Left "Not end of input yet" @=? X.runParser X.pEndOfInput [X.text "&"]    , HU.testCase "text: empty" $ do       Left "Missing text node" @=? X.runParser X.pText []@@ -129,15 +129,15 @@       Left "Missing text node" @=? X.runParser X.pText [unsafeElement "a" [] []]    , HU.testCase "text" $ do-      Right "&" @=? X.runParser X.pText [X.Text "&"]+      Right "&" @=? X.runParser X.pText [X.text "&"]    , HU.testCase "text: concat" $ do       Right "&<" @=? X.runParser X.pText-         [X.Text "&", X.Text "", X.Text "<"]+         [X.text "&", X.text "", X.text "<"]    , HU.testCase "text: twice" $ do       Left "Missing text node" @=? X.runParser (X.pText >> X.pText)-         [X.Text "&", X.Text "", X.Text "<"]+         [X.text "&", X.text "", X.text "<"]    , HU.testCase "element: empty" $ do       Left "Missing element \"x\"" @=? X.runParser (X.pElement "x" (pure ())) []@@ -153,7 +153,7 @@   , HU.testCase "element: text" $ do       Right "ab"         @=? X.runParser (X.pElement "x" X.pText)-                [unsafeElement "x" [] [X.Text "a", X.Text "b"]]+                [unsafeElement "x" [] [X.text "a", X.text "b"]]    , HU.testCase "attr" $ do       Right "a"@@ -174,7 +174,7 @@                 [unsafeElement "x" [("z","b"), ("y","a")] []]    , HU.testCase "read" $ do-      Right False @=? X.runParser (X.pRead =<< X.pText) [X.Text "False"]+      Right False @=? X.runParser (X.pRead =<< X.pText) [X.text "False"]   ]  tt_fixpoints :: Tasty.TestTree@@ -192,23 +192,23 @@       [n0] @=? S.evalState (X.dfM f n0) []    , HU.testCase "df: output single node" $ do-      let n0 = unsafeElement "x" [] [X.Text "a", X.Text "b"]+      let n0 = unsafeElement "x" [] [X.text "a", X.text "b"]           f = \k -> \case-             X.Text "ab" -> k (X.Text "foo")-             X.Text "foo" -> k (X.Text "FOO")+             X.Text "ab" -> k (X.text "foo")+             X.Text "foo" -> k (X.text "FOO")              n -> [n]-          n1 = unsafeElement "x" [] [X.Text "FOO"]+          n1 = unsafeElement "x" [] [X.text "FOO"]       [n1] @=? X.df f n0    , HU.testCase "df: output multiple nodes" $ do-      let n0 = unsafeElement "x" [] [X.Text "a"]+      let n0 = unsafeElement "x" [] [X.text "a"]           f = \k -> \case              X.Text "a" -> let ny = unsafeElement "y" [] [] in [ny, ny] >>= k-             X.Element "y" _ _ -> k (X.Text "b")+             X.Element "y" _ _ -> k (X.text "b")              X.Element "x" as cs  ->-                let nz = unsafeElement "z" as cs in [nz, X.Text "a"] >>= k+                let nz = unsafeElement "z" as cs in [nz, X.text "a"] >>= k              n -> [n]-          ns1 = [unsafeElement "z" [] [X.Text "bb"], X.Text "bb"]+          ns1 = [unsafeElement "z" [] [X.text "bb"], X.text "bb"]       ns1 @=? X.df f n0   ] @@ -222,20 +222,3 @@ bsEncode :: [X.Node] -> B.ByteString bsEncode = BL.toStrict . BB.toLazyByteString . X.encode -{----instance QC.Arbitrary X.Node where-  arbitrary = QC.frequency-    [ (1, X.Element <$> QC.arbitrary)-    , (50, X.Text <$> QC.arbitrary) ]-  shrink (X.Text t0) = X.Text <$> QC.shrink t0-  shrink (X.Element e0) = X.Element <$> QC.shrink e0--instance QC.Arbitrary X.Element where-  arbitrary = X.Element-    <$> QC.arbitrary-    <*> QC.arbitrary-    <*> QC.arbitrary-  shrink (X.Element n as cs) =-    X.Element <$> QC.shrink n <*> QC.shrink as <*> QC.shrink cs--}
xmlbf.cabal view
@@ -1,5 +1,5 @@ name: xmlbf-version: 0.1+version: 0.2 synopsis: XML back and forth! Parser, renderer, ToXml, FromXml, fixpoints. description: XML back and forth! Parser, renderer, ToXml, FromXml, fixpoints. homepage: https://gitlab.com/k0001/xmlbf