xleb (empty) → 0.1.0

raw patch · 7 files changed

+567/−0 lines, 7 filesdep +basedep +containersdep +mtlsetup-changed

Dependencies added: base, containers, mtl, pretty-show, xleb, xml

Files

• CHANGELOG.md +4/−0
• LICENSE +12/−0
• README.md +63/−0
• Setup.hs +2/−0
• examples/atom/Main.hs +89/−0
• src/Text/XML/Xleb.hs +340/−0
• xleb.cabal +57/−0

@@ -0,0 +1,4 @@+0.1.0+=====++Initial working library version.

@@ -0,0 +1,12 @@+Copyright (c) 2017, Getty Ritter+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,63 @@+# Xleb++The `xleb` library defines a simple monadic language for easily parsing XML structures. It does not parse the XML itself, relying on the [`xml`](http://hackage.haskell.org/package/xml) library to define the underlying types and parser, but rather exposes a simple monad with helper functions to make defining XML-based structures quick and straightforward, of roughly equal complexity to defining a `fromJSON` instance for [`aeson`](http://hackage.haskell.org/package/aeson).++## Basic Usage+++The `Xleb` monad describes both parsing _and_ traversing a given XML structure: several of the functions to produce `Xleb` computations take other `Xleb` computations, which are run on various sub-parts of the XML tree. Consequently, instead of decomposing an XML structure and passing it around to various functions, the `Xleb` language treats "the current location in the tree" as an implicit piece of data in the `Xleb` monad.++You will generally want to identify your root note with the `elem` function to ensure that your root note has the tag you expect. Children of that node can be accessed using the `child` or `children` function to either unambiguously find a specific child element, or to find all child elements that match a given selector and apply a `Xleb` computation to each of them.++~~~~.haskell+  a <- X.child (X.byTag "a") parseA+  b <- X.children (X.byTag "b") parseB+~~~~++Leaf data tends to come in two forms in XML: attribute values (like `<tag attr="value">`) or tag content (like `<tag>value</tag>`). In both cases, the `Xleb` functions allow you to parse that content however you'd like by providing an arbitrary function of type `String -> Either String a`. The `xleb` library provides several built-in functions of this type for common situations.++~~~~.haskell+  c <- X.attr "index" X.number+  d <- X.contents X.string+~~~~++Finally, the `Xleb` monad has `Alternative` instances which allow for concise expression of optional values or multiple possibilities.++~~~~.haskell+  e <- X.children X.any (parseA <|> parseB)+  f <- optional (X.attr "total" X.number)+~~~~++## Simple Example++Say we want to parse a simple XML feed format that looks like the following, with the extra caveat that we'd like the `author` field to be optional:++~~~~.xml+<feed>+  <title>Feed Name</title>+  <author>Pierre Menard</author>+  <entry title="Entry 01">First Post</entry>+  <entry title="Entry 02">Second Post Post</entry>+</feed>+~~~~++We can write a `Xleb` computation which is capable of parsing this structure in a handful of lines, here written in a slightly unusual way in order to show off some features of the library:++~~~~.haskell+import           Control.Applicative (optional)+import qualified Text.XML.Xleb as X++feed :: X.Xleb (String, Maybe String, [(String, String)])+feed = X.elem "feed" $ do+  feedTitle   <- X.child (X.byTag "title") $+                   X.contents X.string+  feedAuthor  <- optional $ X.child (X.byTag "author") $+                              X.contents X.string+  feedEntries <- X.children (X.byTag "entry") entry+  return (feedTitle, feedAuthor, feedEntries)++entry :: X.Xleb (String, String)+entry = (,) <$> X.attr "title" X.string <*> X.contents X.string+~~~~++For a larger example, look at the [Atom-parsing example](https://github.com/aisamanra/xleb/blob/master/examples/atom/Main.hs), which is both more idiomatic and more complete.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++import           Control.Applicative (optional)+import qualified Text.Show.Pretty as PP+import qualified Text.XML.Light as XML+import qualified Text.XML.Xleb as X++data Feed = Feed+  { feedTitle    :: String+  , feedSubtitle :: String+  , feedLinks    :: [Link]+  , feedId       :: String+  , feedUpdated  :: String+  , feedEntries  :: [Entry]+  } deriving (Show)++data Link = Link+  { linkHref :: String+  , linkRel  :: Maybe String+  } deriving (Show)++data Entry = Entry+  { entryTitle   :: String+  , entryLinks   :: [Link]+  , entryId      :: String+  , entryUpdated :: String+  , entrySummary :: String+  , entryAuthor  :: Author+  , entryContent :: Content+  } deriving (Show)++data Content+  = XHTMLContent XML.Element+  | HTMLContent String+  | TextContent String+    deriving (Show)++data Author = Author+  { authorName  :: String+  , authorEmail :: String+  } deriving (Show)++feed :: X.Xleb Feed+feed = X.elem "feed" $ do+  feedTitle    <- X.child "title" (X.contents X.string)+  feedSubtitle <- X.child "subtitle" (X.contents X.string)+  feedLinks    <- X.children "link" link+  feedId       <- X.child "id" (X.contents X.string)+  feedUpdated  <- X.child "updated" (X.contents X.string)+  feedEntries  <- X.children "entry" entry+  return Feed { .. }++link :: X.Xleb Link+link =+  Link <$> X.attr "href" X.string+       <*> optional (X.attr "rel" X.string)++entry :: X.Xleb Entry+entry = X.elem "entry" $ do+  entryTitle    <- X.child "title" (X.contents X.string)+  entryLinks    <- X.children "link" link+  entryId       <- X.child "id" (X.contents X.string)+  entryUpdated  <- X.child "updated" (X.contents X.string)+  entrySummary  <- X.child "summary" (X.contents X.string)+  entryAuthor   <- X.child "author" author+  entryContent  <- X.child "content" content+  return Entry { .. }++content :: X.Xleb Content+content = do+  typ <- X.attr "type" X.string+  case typ of+    "xhtml" -> XHTMLContent <$> X.rawElement+    "html"  -> HTMLContent <$> X.contents X.string+    "text"  -> TextContent <$> X.contents X.string+    _       -> fail "Unknown content type"++author :: X.Xleb Author+author =+  Author <$> X.child "name" (X.contents X.string)+         <*> X.child "email" (X.contents X.string)++main :: IO ()+main = do+  cs <- getContents+  PP.pPrint (X.runXleb cs feed)

@@ -0,0 +1,340 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-|+Module      : Text.XML.Xleb+Description : The Xleb XML-parsing monad+Copyright   : (c) Getty Ritter, 2017+License     : BSD+Maintainer  : Getty Ritter <xleb@infinitenegativeutility.com>+Stability   : experimental++The 'Xleb' monad (and the corresponding 'XlebT' monad transformer) is+a monadic sublanguage for easily parsing XML structures.++This module is intended to be imported qualified, to avoid name+clashes with 'Prelude' functions. e.g.++> import qualified Text.XML.Xleb as X++-}+++module Text.XML.Xleb+( -- * How To Use 'Xleb'+  -- $use++  -- * The 'Xleb' monad+  Xleb+, runXleb+  -- ** The 'XlebT' monad transformer+, XlebT+, runXlebT+-- * Errors+, XlebError(..)+, errorString+-- * Element Structure+, elem+, attr+, contents+, rawElement+, child+, children+-- * Parsing contained string data+, Parse+, string+, number+, reader+-- * Selecting Elements+, Selector+, byTag+, any+) where++import           Prelude hiding (any, elem)++import           Control.Applicative (Alternative(..))+import qualified Control.Monad.Fail as M+import qualified Control.Monad.Except as M+import qualified Control.Monad.Reader as M+import qualified GHC.Exts as GHC+import qualified Data.Functor.Identity as M+import qualified Text.XML.Light as XML++-- | The 'XlebT' monad transformer describes a computation used to+-- parse a fragment of XML from a particular element of an XML+-- structure. This may fail with an error, or it may produce a value.+newtype XlebT m a =+  Xleb (M.ReaderT XML.Element (M.ExceptT XlebError m) a)+  deriving (Functor, Applicative, Monad, Alternative)++-- | The 'Xleb' monad describes a computation used to parse a fragment+-- of XML from a particular element of an XML structure. This may fail+-- with an error, or it may produce a value.+type Xleb a = XlebT M.Identity a++-- | The 'XlebError' type describes the various errors that can occur+-- in the course of parsing an XML structure. If you simply want the+-- human-readable string that corresponds to your error, then use the+-- 'errorString' function.+data XlebError+  = XEInElem String XlebError+    -- ^ Describes the element context in which an error occurred+  | XEInAttr String XlebError+    -- ^ Describes the attribute context in which an error occurred+  | XEParseFailure String+    -- ^ Some parser function was unable to produce a value from the+    -- string embedded in an XML element+  | XENoSuchAttribute String+    -- ^ A 'XlebT' computation required an attribute that wasn't+    -- found in the specified element.+  | XEUnexpectedElement String String+    -- ^ A 'XlebT' computation expected one element but found another+  | XENoMatchingElement Selector+    -- ^ A 'XlebT' computation used a selector which did not+    -- successfully describe any child elements+  | XEAmbiguousElement Selector+    -- ^ A 'XlebT' computation used a selector as though it would+    -- unambiguously name a single child, but instead multiple child+    -- elements matched the selector+  | XEBadXML+    -- ^ The "xml" library was unable to parse the document as XML.+  | XOtherError String+    -- ^ Another error occurred which was not described by the above+    -- constructors+    deriving (Eq, Show)++instance Monoid XlebError where+  mappend x _ = x+  mempty = XOtherError "unknown error"++-- | Convert a 'XlebError' value to the corresponding human-readable+-- string.+errorString :: XlebError -> String+errorString = gatherContext ""+  where gatherContext ctx (XEInElem el err) =+          gatherContext (ctx ++ el ++ "/") err+        gatherContext ctx (XEInAttr at err) =+          gatherContext (ctx ++ "[@" ++ at ++ "]") err+        gatherContext ctx err =+          ctx ++ ": " ++ showError err+        showError (XEParseFailure err) = err+        showError XEBadXML =+          "Unable to parse input string as XML"+        showError (XENoSuchAttribute str) =+          "No attribute called '" ++ str ++ "'"+        showError (XEUnexpectedElement e1 e2) =+          "Unexpected element " ++ e1 ++ "; expected " ++ e2+        showError (XENoMatchingElement sel) =+          "No elements were found maching selector " ++ show sel+        showError (XEAmbiguousElement sel) =+          "Multiple elements matched the selector " ++ show sel+        showError (XOtherError str) = str+        showError (XEInElem _ _) = error "[unexpected]"+        showError (XEInAttr _ _) = error "[unexpected]"++instance Monad m => M.MonadFail (XlebT m) where+  fail = Xleb . M.throwError . XOtherError++-- | A value of type @'Parse' t@ is a function that can either produce+-- a value of type @t@ or fail with a string message.+type Parse t = String -> Either String t++-- | A 'Selector' represents some criteria by which child elements are+-- matched.+data Selector+  = SelByName String+  | SelAny+    deriving (Eq, Show)++instance GHC.IsString Selector where+  fromString = SelByName++toPred :: Selector -> XML.Element -> Bool+toPred SelAny _ = True+toPred (SelByName n) el =+  XML.showQName (XML.elName el) == n++-- | Find an attribute on the current focus element and parse it to a+-- value of type @t@. If the parse function fails, then this will fail+-- with 'XEParseFailure'.+attr :: Monad m => String -> Parse t -> XlebT m t+attr name parser = Xleb $ do+  el <- M.ask+  case XML.findAttr (XML.unqual name) el of+    Nothing   -> M.throwError (XENoSuchAttribute name)+    Just a -> case parser a of+      Left err -> M.throwError (XEInAttr name (XEParseFailure err))+      Right x  -> return x++-- | Take the string content of the current element and parse it to a+-- value of type @t@. If the parse function fails, then this will fail+-- with 'XEParseFailure'.+contents :: Monad m => Parse t -> XlebT m t+contents parser = Xleb $ do+  cnt <- XML.strContent `fmap` M.ask+  case parser cnt of+    Left err -> M.throwError (XEParseFailure err)+    Right x  -> return x++-- | Access the raw underlying XML element that we are+-- processing. This is sometimes necessary for working with free-form+-- XML data.+rawElement :: Monad m => XlebT m XML.Element+rawElement = Xleb M.ask++-- | Use a 'Selector' that unambiguously identifies a single child+-- element of the current element and then parse it according to a+-- given 'XlebT' computation focused on that element. If no child+-- matches the provided 'Selector', then this will fail with+-- 'XENoMatchingElement'. If multiple children match the provided+-- 'Selector', then this will fail with 'XEAmbiguousElement'.+child :: Monad m => Selector -> XlebT m t -> XlebT m t+child sel (Xleb mote) = Xleb $ do+  cld <- XML.filterChildren (toPred sel) `fmap` M.ask+  case cld of+    []  -> M.throwError (XENoMatchingElement sel)+    [x] -> M.local (const x) mote+    _   -> M.throwError (XEAmbiguousElement sel)++-- | Use a 'Selector' that identifies some child elements of the+-- current element and parse each according to a given 'XlebT'+-- computation, which will be repeated with focus on each child+-- element, and returning the resulting values as a list. If no child+-- elements match the 'Selector', then this will return an empty list.+children :: Monad m => Selector -> XlebT m t -> XlebT m [t]+children sel (Xleb mote) = Xleb $ do+  cld <- XML.filterChildren (toPred sel) `fmap` M.ask+  sequence [ M.local (const x) mote | x <- cld ]++-- | A 'Parse' function that parses numeric values according to their+-- Haskell 'Read' instance.+number :: (Read n, Num n) => Parse n+number = Right . read++-- | A 'Parse' function that accepts arbitrary string input without+-- failing.+string :: Parse String+string = Right++-- | A 'Parse' function that parses Haskell values according to their+-- 'Read' instance.+reader :: Read a => Parse a+reader = Right . read++-- | Creates a 'Selector' which expects an exact tag name.+byTag :: String -> Selector+byTag = SelByName++-- | Creates a 'Selector' which matches any possible child element.+any :: Selector+any = SelAny++-- | @'elem' n t@ will ensure that the currently focused element is a+-- tag named @n@ and will then evaluate it using the computation+-- @t@. This will fail with 'XEUnexpectedElement' if the tag is named+-- something else.+elem :: Monad m => String -> XlebT m t -> XlebT m t+elem name (Xleb mote) = Xleb $ do+  el <- M.ask+  case el of+    XML.Element { XML.elName = qname }+      | XML.showQName qname == name -> mote+      | otherwise -> M.throwError+        (XEUnexpectedElement (XML.showQName qname) name)++doXleb :: XML.Element -> XlebT m t -> m (Either XlebError t)+doXleb el (Xleb mote) =+  M.runExceptT (M.runReaderT mote el)++-- | Run a 'Xleb' computation over a string containing XML data,+-- producing either the resulting value or an error. If the XML data+-- contained in the argument string is invalid, then this will fail+-- with 'XEBadXML'.+runXleb :: String -> Xleb t -> Either XlebError t+runXleb raw xleb = case XML.parseXMLDoc raw of+  Nothing -> Left XEBadXML+  Just x  -> M.runIdentity (doXleb x xleb)++-- | Run a 'XlebT' computation over a string containing XML data,+-- producing either the resulting monadic value or an error. If the+-- XML data contained in the argument string is invalid, then this+-- will fail with 'XEBadXML'.+runXlebT :: Monad m => String -> XlebT m t -> m (Either XlebError t)+runXlebT raw xleb = case XML.parseXMLDoc raw of+  Nothing -> return (Left XEBadXML)+  Just x  -> doXleb x xleb++{- $use++The 'Xleb' monad describes both parsing /and/ traversing a given XML+structure: several of the functions to produce 'Xleb' computations+take other 'Xleb' computations, which are run on various sub-parts of+the XML tree. Consequently, instead of decomposing an XML structure+and passing it around to various functions, the 'Xleb' language treats+"the current location in the tree" as an implicit piece of data in the+'Xleb' monad.++You will generally want to identify your root note with the 'elem'+function to ensure that your root note has the tag you+expect. Children of that node can be accessed using the 'child' or+'children' function to either unambiguously find a specific child+element, or to find all child elements that match a given selector and+apply a 'Xleb' computation to each of them.++@+  a <- X.child (X.byTag "a") parseA+  b <- X.children (X.byTag "b") parseB+@++Leaf data tends to come in two forms in XML: attribute values (like+@\<tag attr="value"\>@) or tag content (like+@\<tag\>value\<\/tag\>@). In both cases, the 'Xleb' functions allow+you to parse that content however you'd like by providing an arbitrary+function of type @'String' -> 'Either' 'String' a@. The "xleb" library+provides several built-in functions of this type for common+situations.++@+  c <- X.attr "index" X.number+  d <- X.contents X.string+@++Finally, the `Xleb` monad has `Alternative` instances which allow for+concise expression of optional values or multiple possibilities.++@+  e \<- X.children X.any (parseA \<|\> parseB)+  f \<- optional (X.attr "total" X.number)+@++Consequently, for an XML structure like the following:++@+\<feed\>+  \<title\>Feed Name\<\/title\>+  \<author\>Pierre Menard\<\/author\>+  \<entry title="Entry 01"\>First Post\<\/entry\>+  \<entry title="Entry 02"\>Second Post Post\<\/entry\>+\<\/feed\>+@++We can write a 'Xleb' computation which is capable of parsing this+structure in a handful of lines:++@+import           Control.Applicative (optional)+import qualified Text.XML.Xleb as X++feed :: X.Xleb (String, Maybe String, [(String, String)])+feed = X.elem "feed" $ do+  feedTitle   <- X.child (X.byTag "title") $+                   X.contents X.string+  feedAuthor  <- optional $ X.child (X.byTag "author") $+                              X.contents X.string+  feedEntries <- X.children (X.byTag "entry") entry+  return (feedTitle, feedAuthor, feedEntries)++entry :: X.Xleb (String, String)+entry = (,) \<$\> X.attr "title" X.string \<*\> X.contents X.string+@++-}

@@ -0,0 +1,57 @@+name:             xleb+version:          0.1.0+synopsis:         A simple monadic language for parsing XML structures.+homepage:         https://github.com/aisamanra/xleb+description:+  A simple monadic language designed for easily describing and parsing+  XML structures.+  .+  The library in general has a small surface area and should be easy+  to pick up just given the Haddock documentation, but slightly more+  involved documentation can be found at+  <https://github.com/aisamanra/xleb the Xleb github page> along with+  <https://github.com/aisamanra/xleb/tree/master/examples some examples>.+  .+  Please report bugs and suggest features at+  <https://github.com/aisamanra/xleb/issues the Xleb issue tracker>.+license:          BSD3+license-file:     LICENSE+author:           Getty Ritter <xleb@infinitenegativeutility.com>+maintainer:       Getty Ritter <xleb@infinitenegativeutility.com>+copyright:        ©2017 Getty Ritter+category:         XML+build-type:       Simple+cabal-version:    >= 1.18+bug-reports:      https://github.com/aisamanra/xleb/issues+extra-doc-files:  README.md,+                  CHANGELOG.md++source-repository head+  type: git+  location: git://github.com/aisamanra/s-cargot.git++flag build-examples+  description: Build example applications+  default:     False++library+  exposed-modules:     Text.XML.Xleb+  hs-source-dirs:      src+  ghc-options:         -Wall+  build-depends:       base       >= 4.7    && <5+                     , xml        >= 1.3    && <1.4+                     , containers >= 0.5.10 && <0.6+                     , mtl        >= 2.2    && <2.3+  default-language:    Haskell2010++executable atom+  if !flag(build-examples)+    buildable: False+  hs-source-dirs:   examples/atom+  main-is:          Main.hs+  ghc-options:      -Wall+  build-depends:    base        >=4.7    && <5+                  , xleb+                  , xml         >= 1.3   && <1.4+                  , pretty-show >= 1.6   && <1.7+  default-language: Haskell2010