hexml-lens 0.1.1 → 0.2.0
raw patch · 3 files changed
+183/−202 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- examples/courses.hs +60/−21
- hexml-lens.cabal +18/−9
- src/Text/XML/Hexml/Lens.hs +105/−172
examples/courses.hs view
@@ -1,42 +1,81 @@-{-# LANGUAGE RecordWildCards #-}-import Control.Lens hiding (children)-import qualified Data.ByteString as B+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS -Wno-unused-top-binds #-}++import Control.Applicative+import qualified Control.Category as C+import Control.Lens hiding (children) import qualified Data.ByteString.Lazy.Char8 as LB-import Network.Wreq-import Text.XML.Hexml-import Text.XML.Hexml.Lens+import Network.Wreq+import Text.XML.Hexml+import Text.XML.Hexml.Lens -url :: [Char]+url,url2 :: String url = "http://aiweb.cs.washington.edu/research/projects/xmltk/xmldata/data/courses/reed.xml"+url2 = "http://aiweb.cs.washington.edu/research/projects/xmltk/xmldata/data/courses/uwm.xml"+url_local = "/Users/pepe/Downloads/reed.xml"+url2_local = "/Users/pepe/Downloads/uwm.xml" +type Strings = String+ data Place s = Place { building :: s- , room :: Int+ , room :: Int } deriving Show data Course s = Course- { title, instructor :: s- , place :: Place s+ { title :: s+ , instructor :: Maybe s+ , place :: Maybe (Place s)+ , sections :: [Section s] } deriving Show +data Section s = Section+ { name :: s+ , days :: s+ , start, end :: s+ , instructor :: s+ }+ deriving Show+ main :: IO () main = do- r <- get url- let stripDocType = LB.unlines . drop 2 . LB.lines- let courses = take 10 $ r ^.. responseBody . to stripDocType . _XML . _children . courseF+ r <- get url2_local+ let courses = take 10 $ r ^.. responseBody . to stripDocTypeB . _XML . node "course_listing" . courseF print courses -courseF :: Fold Node (Course B.ByteString)+stripDocTypeB :: LB.ByteString -> LB.ByteString+stripDocTypeB = LB.unlines . drop 2 . LB.lines+stripDocType :: String -> String+stripDocType = unlines . drop 2 . lines++courseF :: Fold Node (Course Strings) courseF = runFold $ do- title <- Fold $ node "title" . textContents- instructor <- Fold $ node "instructor" . textContents- place <- Fold $ node "place" . placeF- return $ Course{..}+ title <- field "title"+ instructor <- optional $ field "instructor"+ place <- optional $ Fold $ node "place" . placeF+ sections <- Fold $ many $ node "section_listing" . sectionF+ return Course{..} -placeF :: Fold Node (Place B.ByteString)+sectionF :: Fold Node (Section Strings)+sectionF = runFold $ do+ instructor <- field "instructor"+ name <- field "section"+ days <- field "days"+ (start, end) <- Fold $ node "hours" . runFold hoursF+ return Section{..}++hoursF :: ReifiedFold Node (Strings, Strings)+hoursF = (,) <$> field "start" <*> field "end"++placeF :: Fold Node (Place Strings) placeF = runFold $ do- building <- Fold $ node "building" . textContents- room <- Fold $ node "room" . textContents . _Show+ building <- field "building"+ room <- Fold _Show C.. field "room" return (Place building room)++field :: (XML a, XML t) => t -> ReifiedFold Node a+field n = Fold $ node n . _inner
hexml-lens.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: hexml-lens-version: 0.1.1+version: 0.2.0 synopsis: Lenses for the hexml package description: Lenses for the hexml package category: lens@@ -19,6 +19,11 @@ extra-source-files: README.md +flag buildExamples+ description: build the examples+ manual: True+ default: False+ library hs-source-dirs: src@@ -38,13 +43,16 @@ main-is: courses.hs hs-source-dirs: examples- build-depends:- base- , bytestring- , hexml- , hexml-lens- , lens- , wreq+ if flag(buildExamples)+ build-depends:+ base+ , bytestring+ , hexml+ , hexml-lens+ , lens+ , wreq+ else+ buildable: False default-language: Haskell2010 test-suite doctests@@ -53,7 +61,8 @@ hs-source-dirs: test build-depends:- doctest+ base+ , doctest , hexml-lens , QuickCheck default-language: Haskell2010
src/Text/XML/Hexml/Lens.hs view
@@ -1,167 +1,37 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE RankNTypes #-} module Text.XML.Hexml.Lens ( -- * Nodes _children- , ChildNode(..)- , Contents(..)- , TextContents(..)- -- * Attributes- , Attributes(..)- -- * Parsing- , AsXML(..)+ , XML(..)+ , node ) where -import Control.Arrow-import Control.Lens hiding (children)-import qualified Data.ByteString as Strict-import qualified Data.ByteString.Internal as Strict-import qualified Data.ByteString.Lazy as Lazy-import Data.ByteString.Lens-import Data.String-import qualified Data.Text as Strict-import qualified Data.Text.Lazy as Lazy-import qualified Data.Text.Encoding as Strict-import qualified Data.Text.Lazy.Encoding as Lazy-import Data.Text.Lens-import qualified Foundation as F-import qualified Foundation.String as F+import Control.Arrow+import Control.Lens hiding (children)+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Internal as Strict+import qualified Data.ByteString.Lazy as Lazy+import Data.ByteString.Lens+import Data.String+import qualified Data.Text as Strict+import qualified Data.Text.Encoding as Strict+import qualified Data.Text.Lazy as Lazy+import qualified Data.Text.Lazy.Encoding as Lazy+import Data.Text.Lens+import qualified Foundation as F import qualified Foundation.Array.Internal as F-import Text.XML.Hexml---- | Fold over the element children-_children :: Fold Node Node-_children = folding children-- -- | Fold over all the children (text and element)-class Contents s where- _contents :: Fold Node (Either s Node)--instance Contents String where- _contents = _contents . firsting (from strictUtf8)--instance Contents F.String where- _contents = _contents . lefting (foundation F.UTF8)--instance Contents Strict.Text where- _contents = _contents . firsting (from strictTextUtf8)--instance Contents Lazy.Text where- _contents = _contents . firsting (from lazyTextUtf8)--instance Contents Strict.ByteString where- _contents = folding contents--instance Contents Lazy.ByteString where- _contents = _contents . firsting lazy---- ------------------------------------------------------------------------------------ | Folds for element nodes-class ChildNode s where- -- | Fold over a specific child- node :: s -> Fold Node Node---- | A fold for accessing named children nodes--- This is a more efficient version of------ > node foo = _children . filtered (\n -> name n == foo)-instance ChildNode String where- node name_ = node ( name_ ^. strictUtf8)---- | A fold for accessing named children nodes--- This is a more efficient version of------ > node foo = _children . filtered (\n -> name n == foo)-instance ChildNode F.String where- node name_ = node ( F.toList name_ ^. strictUtf8)---- | A fold for accessing named children nodes--- This is a more efficient version of------ > node foo = _children . filtered (\n -> name n == foo)-instance ChildNode Strict.ByteString where- node name_ = folding $ flip childrenBy name_--instance ChildNode Lazy.ByteString where- node name_ = node (name_ ^. strict)---- | A fold for accessing named children nodes--- This is a more efficient version of------ > node foo = _children . filtered (\n -> name n == foo)-instance ChildNode Strict.Text where- node name_ = node ( name_ ^. strictTextUtf8 )--instance ChildNode Lazy.Text where- node name_ = node ( name_ ^. lazyTextUtf8 )---- | A fold for accessing a child node by its index-instance ChildNode Int where- node n = folding $ take 1 . drop n . children---- ------------------------------------------------------------------------------------- | Fold for accessing the text contents of a node-class TextContents s where- textContents :: Fold Node s--instance TextContents Strict.ByteString where- textContents = folding contents . _Left--instance TextContents Lazy.ByteString where- textContents = textContents . lazy--instance TextContents String where- textContents = textContents @Strict.ByteString . from strictUtf8--instance TextContents Strict.Text where- textContents = textContents . from strictTextUtf8--instance TextContents Lazy.Text where- textContents = textContents . from lazyTextUtf8--instance TextContents F.String where- textContents = textContents . foundation F.UTF8---- ------------------------------------------------------------------------------------- | Optics for accessing attributes-class Attributes s where- -- | Fold for accessing attributes by name.- _Attribute :: s -> Getter Node (Maybe s)- -- | Name-Indexed fold over the attribute values- iattributes :: IndexedFold String Node s--instance Attributes Strict.ByteString where- _Attribute n = pre $ to(`attributeBy` n).folded.to(attributeValue)- iattributes = ifolding (map (\ (Attribute n v) -> (n^.from strictUtf8, v)) . attributes )--instance Attributes Lazy.ByteString where- _Attribute n = _Attribute(n^.strict).mapping(lazy)- iattributes = iattributes.lazy--instance Attributes String where- _Attribute n = _Attribute(n ^. packedChars).mapping(from strictUtf8)- iattributes = iattributes @ Strict.ByteString . unpackedChars--instance Attributes Strict.Text where- _Attribute n = _Attribute(n ^. strictTextUtf8).mapping(from strictTextUtf8)- iattributes = iattributes . packed--instance Attributes Lazy.Text where- _Attribute n = _Attribute(n ^. lazyTextUtf8).mapping(from lazyTextUtf8)- iattributes = iattributes . packed--instance Attributes F.String where- _Attribute n = pre $ to (`attributeBy` (F.toList n ^. packedChars)) . folded . to attributeValue . foundation F.UTF8- iattributes = iattributes . to fromString+import qualified Foundation.String as F+import Text.XML.Hexml --- ---------------------------------------------------------------------------------+-- | Getter for the element children+_children :: Getter Node [Node]+_children = to children -class AsXML s where+class XML s where -- | A prism for parsing and unparsing XML. -- -- unparsing is provided by 'outer'.@@ -174,10 +44,10 @@ -- >>> "<?xml version=\"1.0\"?><foo/>" ^? _XML.to name -- Just "" --- -- >>> "<?xml version=\"1.0\"?><foo/>" ^? _XML.node(0::Int)+ -- >>> "<?xml version=\"1.0\"?><foo/>" ^? _XML._children.ix(0) -- Just Node "<?xml version=\"1.0\"?>" --- -- >>> "<?xml version=\"1.0\"?><foo/>" ^? _XML.node(1::Int)+ -- >>> "<?xml version=\"1.0\"?><foo/>" ^? _XML._children.ix(1) -- Just Node "<foo/>" -- -- If the tree has only 1 root, no nameless nodes are inserted.@@ -192,30 +62,93 @@ -- Just "" -- >>> parse "<foo/>" ^? _Right.re(_XML @String)._XML.to name -- Just "foo"- _XML :: Prism' s Node -instance AsXML Strict.ByteString where- _XML = prism' outer doParse where- doParse x =- case parse x of- Right n -> Just $ case children n of [y] -> y ; _ -> n- Left _ -> Nothing+ -- | Fold over all the children (text and element)+ _contents :: Fold Node (Either s Node)+ -- | Getter for the 'inner' contents of a node+ _inner :: Getter Node s+ -- | Getter for the 'inner' contents of a node+ _outer :: Getter Node s+ -- | Fold for accessing the text contents of a node+ textContents :: Fold Node s+ -- | Fold for accessing attributes by name.+ _Attribute :: s -> Getter Node (Maybe s)+ -- | Name-Indexed fold over the attribute values+ iattributes :: IndexedFold String Node s+ -- | A getter for accessing named children nodes+ -- This is a more efficient version of+ --+ -- > nodes foo = _children . to (filter (\n -> name n == foo))+ nodes :: s -> Getter Node [Node] -instance AsXML Lazy.ByteString where- _XML = strict . _XML @ Strict.ByteString+-- | > node n = nodes n . folded+node :: XML s => s -> Fold Node Node+node n = nodes n . folded -instance AsXML String where+instance XML String where _XML = strictUtf8 . _XML @ Strict.ByteString+ _contents = _contents . firsting (from strictUtf8)+ _inner = _inner . from strictUtf8+ _outer = _outer . from strictUtf8+ textContents = textContents @Strict.ByteString . from strictUtf8+ _Attribute n = _Attribute(n ^. packedChars).mapping(from strictUtf8)+ iattributes = iattributes @ Strict.ByteString . unpackedChars+ nodes name_ = nodes ( name_ ^. strictUtf8) -instance AsXML Strict.Text where+instance XML F.String where+ _contents = _contents . lefting (foundation F.UTF8)+ _inner = _inner . foundation F.UTF8+ _outer = _outer . foundation F.UTF8+ textContents = textContents . foundation F.UTF8+ _Attribute n = pre $ to (`attributeBy` (F.toList n ^. packedChars)) . folded . to attributeValue . foundation F.UTF8+ iattributes = iattributes . to fromString+ nodes name_ = nodes ( F.toList name_ ^. strictUtf8)++instance XML Strict.Text where _XML = strictTextUtf8 . _XML+ _contents = _contents . firsting (from strictTextUtf8)+ _inner = _inner . from strictTextUtf8+ _outer = _outer . from strictTextUtf8+ textContents = textContents . from strictTextUtf8+ _Attribute n = _Attribute(n ^. strictTextUtf8).mapping(from strictTextUtf8)+ iattributes = iattributes . packed+ nodes name_ = nodes ( name_ ^. strictTextUtf8 ) -instance AsXML Lazy.Text where+instance XML Lazy.Text where _XML = lazyTextUtf8 . _XML+ _contents = _contents . firsting lazy+ _inner = _inner . lazy+ _outer = _outer . lazy+ textContents = textContents . from lazyTextUtf8+ _Attribute n = _Attribute(n ^. lazyTextUtf8).mapping(from lazyTextUtf8)+ iattributes = iattributes . packed+ nodes name_ = nodes ( name_ ^. lazyTextUtf8 ) --- ---------------------------------------------------------------------------------+instance XML Strict.ByteString where+ _XML = prism' outer doParse where+ doParse x =+ case parse x of+ Right n -> Just $ case children n of [y] -> y ; _ -> n+ Left _ -> Nothing+ _contents = folding contents+ _inner = to inner+ _outer = to outer+ textContents = folding contents . _Left+ _Attribute n = pre $ to(`attributeBy` n).folded.to(attributeValue)+ iattributes = ifolding (map (\ (Attribute n v) -> (n^.from strictUtf8, v)) . attributes )+ nodes name_ = to $ flip childrenBy name_ +instance XML Lazy.ByteString where+ _XML = strict . _XML @ Strict.ByteString+ _contents = _contents . firsting lazy+ _inner = _inner . lazy+ _outer = _outer . lazy+ textContents = textContents . lazy+ _Attribute n = _Attribute(n^.strict).mapping(lazy)+ iattributes = iattributes.lazy+ nodes name_ = nodes (name_ ^. strict)+ lazyTextUtf8 :: Iso' Lazy.Text Lazy.ByteString lazyTextUtf8 = iso Lazy.encodeUtf8 Lazy.decodeUtf8 @@ -225,8 +158,8 @@ strictUtf8 :: Iso' String Strict.ByteString strictUtf8 = packed . strictTextUtf8 -foundation :: F.Encoding -> Fold Strict.ByteString F.String-foundation encoding = to (F.fromBytes encoding . fromByteString) . filtered (hasn't (_2.folded)) . _1+foundation :: F.Encoding -> Getter Strict.ByteString F.String+foundation encoding = to (F.fromBytes encoding . fromByteString) . {-. filtered (hasn't (_2.folded))-} _1 where fromByteString = F.fromForeignPtr . Strict.toForeignPtr