xml-query-xml-types (empty) → 0.4
raw patch · 9 files changed
+374/−0 lines, 9 filesdep +QuickCheckdep +basedep +base-preludesetup-changed
Dependencies added: QuickCheck, base, base-prelude, data-default-class, free, html-entities, quickcheck-instances, success, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, text, transformers, xml-conduit, xml-query, xml-query-xml-types, xml-types
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- library/XMLQuery/XMLTypes.hs +16/−0
- library/XMLQuery/XMLTypes/Interpreter.hs +87/−0
- library/XMLQuery/XMLTypes/Prelude.hs +29/−0
- library/XMLQuery/XMLTypes/Renderer.hs +36/−0
- tasty/Main.hs +34/−0
- tasty/Main/Queries.hs +55/−0
- xml-query-xml-types.cabal +93/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Sannsyn AS++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ library/XMLQuery/XMLTypes.hs view
@@ -0,0 +1,16 @@+module XMLQuery.XMLTypes where++import XMLQuery.XMLTypes.Prelude+import Data.XML.Types+import qualified XMLQuery as Query+import qualified XMLQuery.XMLTypes.Interpreter as Interpreter+import qualified Success.Pure as Success+++element :: Query.Element a -> Element -> Either (Maybe Text) a+element query input =+ Success.asEither (Interpreter.element query input)++nodes :: Query.Nodes a -> [Node] -> Either (Maybe Text) a+nodes query input =+ Success.asEither (Interpreter.nodes query input)
+ library/XMLQuery/XMLTypes/Interpreter.hs view
@@ -0,0 +1,87 @@+module XMLQuery.XMLTypes.Interpreter where++import XMLQuery.XMLTypes.Prelude+import Data.XML.Types+import qualified XMLQuery.AST as AST+import qualified XMLQuery.XMLTypes.Renderer as Renderer+import qualified Success.Pure as Success+++type Result =+ Success Text++nodes :: Alt AST.Nodes a -> [Node] -> Result a+nodes (Alt alternatives) input =+ runAlternatives alternatives input+ where+ runAlternatives alternatives input =+ asum (map (\alternative -> runAlternative alternative input) alternatives)+ runAlternative alternative input =+ case alternative of+ Ap fa altfab ->+ case fa of+ AST.NodesNode query ->+ case input of+ head : tail ->+ nodes altfab tail <*>+ node query head+ _ ->+ Success.failure "No more nodes"+ Pure a ->+ Success.success a++node :: Alt AST.Node a -> Node -> Result a+node alt node =+ runAlt interpreter alt+ where+ interpreter :: forall a. AST.Node a -> Result a+ interpreter =+ \case+ AST.NodeElement alt ->+ case node of+ NodeElement input ->+ element alt input+ _ ->+ Success.failure "Not an element node"+ AST.NodeText ast ->+ case node of+ NodeContent content ->+ text ast (Renderer.run Renderer.content content)+ _ ->+ Success.failure "Not a content node"++element :: Alt AST.Element a -> Element -> Result a+element alt input =+ runAlt interpreter alt+ where+ interpreter :: forall a. AST.Element a -> Result a+ interpreter =+ \case+ AST.ElementNameText textAST ->+ text textAST (Renderer.run Renderer.name (elementName input))+ AST.ElementAttr attrAST ->+ asum (map (attr attrAST) (elementAttributes input))+ AST.ElementNodes ast ->+ nodes ast (elementNodes input)++attr :: Alt AST.Attr a -> (Name, [Content]) -> Result a+attr alt input =+ runAlt interpreter alt+ where+ interpreter :: forall a. AST.Attr a -> Result a+ interpreter =+ \case+ AST.AttrNameText ast ->+ text ast (Renderer.run Renderer.name (fst input))+ AST.AttrValueText ast ->+ text ast (Renderer.run Renderer.contents (snd input))++text :: Alt AST.Text a -> Text -> Result a+text alt input =+ runAlt interpreter alt+ where+ interpreter :: forall a. AST.Text a -> Result a+ interpreter =+ \case+ AST.Text fn ->+ either Success.failure Success.success (fn input)
+ library/XMLQuery/XMLTypes/Prelude.hs view
@@ -0,0 +1,29 @@+module XMLQuery.XMLTypes.Prelude+( + module Exports,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (fail, Alt)++-- transformers+-------------------------+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.Trans.Class as Exports++-- text+-------------------------+import Data.Text as Exports (Text)++-- success+-------------------------+import Success.Pure as Exports (Success)++-- free+-------------------------+import Control.Alternative.Free as Exports+import Control.Monad.Free as Exports hiding (Pure)
+ library/XMLQuery/XMLTypes/Renderer.hs view
@@ -0,0 +1,36 @@+module XMLQuery.XMLTypes.Renderer where++import XMLQuery.XMLTypes.Prelude+import Data.XML.Types+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy as LazyText+import qualified HTMLEntities.Decoder+++type Renderer a =+ a -> Builder.Builder++run :: Renderer a -> a -> Text+run renderer input =+ LazyText.toStrict $+ Builder.toLazyText $+ renderer input++name :: Renderer Name+name =+ \(Name local ns prefix) ->+ foldMap (\x -> Builder.fromText x <> Builder.singleton ':') prefix <>+ Builder.fromText local++contents :: Renderer [Content]+contents =+ foldMap content+ +content :: Renderer Content+content =+ \case+ ContentText x ->+ Builder.fromText x+ ContentEntity x -> + either (error "XMLQuery.XMLTypes.Renderer.content: corrupt ContentEntity") Builder.fromText $+ HTMLEntities.Decoder.htmlEntity x
+ tasty/Main.hs view
@@ -0,0 +1,34 @@+module Main where++import BasePrelude hiding (assert)+import Data.Default.Class+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.SmallCheck+import Test.Tasty.QuickCheck+import Data.Text (Text)+import qualified Test.QuickCheck as QuickCheck+import qualified Main.Queries as Queries+import qualified XMLQuery as XMLQuery+import qualified XMLQuery.XMLTypes as XMLQueryXMLTypes+import qualified Text.XML as XMLConduit+import qualified Data.XML.Types as XMLTypes+++main =+ defaultMain tree++tree =+ testGroup "All tests"+ [+ testCase "sample 1" $+ queryFile Queries.query1 "samples/1.xml" >>=+ \x -> assertEqual (show x) (Right ("Ehrlin, Carl-Johan Forssén", "9788202505929", ["Bøker", "Barnas ARK"])) x+ ]++queryFile :: XMLQuery.Element a -> String -> IO (Either (Maybe Text) a)+queryFile query filename =+ XMLConduit.readFile def filename >>=+ pure . XMLQueryXMLTypes.element query . XMLTypes.documentRoot . XMLConduit.toXMLDocument+
+ tasty/Main/Queries.hs view
@@ -0,0 +1,55 @@+module Main.Queries where++import BasePrelude+import XMLQuery+import qualified Data.Text as Text+++query1 :: Element (Text.Text, Text.Text, [Text.Text])+query1 =+ elementNameIs "response" *>+ elementNodes (nodesEventualNode (nodeElement element))+ where+ element =+ elementNameIs "result" *>+ elementNodes (nodesEventualNode (nodeElement element))+ where+ element =+ elementNameIs "doc" *>+ ((,,) <$> author <*> isbn <*> mainCatalogueArea)+ where+ author =+ elementNodes (nodesEventualNode (nodeElement element))+ where+ element =+ elementAttr attr *>+ elementNodes nodes+ where+ attr =+ attrNameIs "name" *>+ attrValueIs "author"+ nodes =+ nodesEventualNode (nodeElement (elementNodes (nodesEventualNode (nodeText textValue))))+ isbn =+ elementNodes (nodesEventualNode (nodeElement element))+ where+ element =+ elementAttr attr *>+ elementNodes (nodesEventualNode (nodeText textValue))+ where+ attr =+ attrNameIs "name" *>+ attrValueIs "isbn"+ mainCatalogueArea =+ elementNodes (nodesEventualNode (nodeElement element))+ where+ element =+ elementAttr attr *>+ elementNodes (many (nodesEventualNode (nodeElement (elementNodes (nodesEventualNode (nodeText textValue))))))+ where+ attr =+ attrNameIs "name" *>+ attrValueIs "main_catalog_area"+++
+ xml-query-xml-types.cabal view
@@ -0,0 +1,93 @@+name:+ xml-query-xml-types+version:+ 0.4+synopsis:+ An interpreter of "xml-query" queries for the "xml-types" documents+category:+ Data, XML, Parsing+homepage:+ https://github.com/sannsyn/xml-query-xml-types +bug-reports:+ https://github.com/sannsyn/xml-query-xml-types/issues +author:+ Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+ Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+ (c) 2015, Sannsyn AS+license:+ MIT+license-file:+ LICENSE+build-type:+ Simple+cabal-version:+ >=1.10+++source-repository head+ type:+ git+ location:+ git://github.com/sannsyn/xml-query-xml-types.git+++library+ hs-source-dirs:+ library+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ other-modules:+ XMLQuery.XMLTypes.Prelude+ XMLQuery.XMLTypes.Renderer+ XMLQuery.XMLTypes.Interpreter+ exposed-modules:+ XMLQuery.XMLTypes+ build-depends:+ html-entities >= 1.1 && < 1.2,+ xml-query >= 0.9 && < 0.10,+ xml-types >= 0.3.6 && < 0.4,+ --+ text == 1.*,+ --+ free >= 4.12 && < 5,+ success == 0.2.*,+ transformers >= 0.3 && < 0.5,+ base-prelude >= 0.1.19 && < 0.2+++test-suite tasty+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ tasty+ main-is:+ Main.hs+ other-modules:+ Main.Queries+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ -- + xml-query,+ xml-query-xml-types,+ xml-types,+ xml-conduit,+ -- testing:+ tasty == 0.11.*,+ tasty-quickcheck == 0.8.*,+ tasty-smallcheck == 0.8.*,+ tasty-hunit == 0.9.*,+ quickcheck-instances >= 0.3.11 && < 0.4,+ QuickCheck >= 2.8.1 && < 2.9,+ -- data:+ text == 1.*,+ -- general:+ data-default-class,+ base-prelude,+ base