diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/library/XMLQuery.hs b/library/XMLQuery.hs new file mode 100644 --- /dev/null +++ b/library/XMLQuery.hs @@ -0,0 +1,152 @@ +module XMLQuery +where + +import XMLQuery.Prelude hiding (Text) +import qualified XMLQuery.Prelude as Prelude +import qualified XMLQuery.AST as AST + + +-- * Text +------------------------- + +-- | +-- Parser in the context of a textual value. +type Text = + Alt AST.Text + +-- | +-- Lifts an arbitrary textual parser function to the text-value parser. +-- +-- Provides a doorway for composition with such libraries as \"parsec\" or \"attoparsec\". +text :: (Prelude.Text -> Either Prelude.Text a) -> Text a +text = + liftAlt . AST.Text + +-- ** Derivatives +------------------------- + +-- | +-- Simply extracts the textual value. +textValue :: Text Prelude.Text +textValue = + text pure + + +-- * Element +------------------------- + +type Element = + Alt AST.Element + +elementNameText :: Text a -> Element a +elementNameText = + liftAlt . AST.ElementNameText + +-- | +-- Parses one of element's attributes without any regard to order. +elementAttr :: Attr a -> Element a +elementAttr = + liftAlt . AST.ElementAttr + +-- | +-- Parses all of element's nodes. +-- +-- Can be used multiple times, +-- thus allowing for parallel parsing of element's child-nodes. +-- Naturally this will result in traversing the element's nodes multiple times. +elementNodes :: Nodes a -> Element a +elementNodes = + liftAlt . AST.ElementNodes + +-- ** Derivatives +------------------------- + +elementNameIs :: Prelude.Text -> Element () +elementNameIs expected = + elementNameText (text textParserFn) + where + textParserFn actual = + if actual == expected + then Right () + else Left ("elementNameIs: The actual name \"" <> actual <> "\" does not equal the expected \"" <> expected <> "\"") + + +-- * Attr +------------------------- + +type Attr = + Alt AST.Attr + +-- | +-- Parses the attribute's name using the provided textual parser. +attrNameText :: Text a -> Attr a +attrNameText = + liftAlt . AST.AttrNameText + +-- | +-- Parses the attribute's value using the provided textual parser. +attrValueText :: Text a -> Attr a +attrValueText = + liftAlt . AST.AttrValueText + +-- ** Derivatives +------------------------- + +-- | +-- A parser, which succeeds if the attribute's name matches the provided value. +attrNameIs :: Prelude.Text -> Attr () +attrNameIs expected = + attrNameText (text textParserFn) + where + textParserFn actual = + if actual == expected + then Right () + else Left ("attrNameIs: The actual name \"" <> actual <> "\" does not equal the expected \"" <> expected <> "\"") + +-- | +-- A parser, which succeeds if the attribute's value matches the provided value. +attrValueIs :: Prelude.Text -> Attr () +attrValueIs expected = + attrValueText (text textParserFn) + where + textParserFn actual = + if actual == expected + then Right () + else Left ("attrValueIs: The actual name \"" <> actual <> "\" does not equal the expected \"" <> expected <> "\"") + + +-- * Nodes +------------------------- + +-- | +-- A sequential backtracking parser of nodes. +type Nodes = + Alt AST.Nodes + +-- | +-- Parses the next node. +nodesImmediateNode :: Node a -> Nodes a +nodesImmediateNode = + liftAlt . AST.NodesNode + +-- | +-- Parses one of the following nodes. +nodesEventualNode :: Node a -> Nodes a +nodesEventualNode node = + fix $ \loop -> + nodesImmediateNode node <|> (nodesImmediateNode (pure ()) *> loop) + + +-- * Node +------------------------- + +type Node = + Alt AST.Node + +nodeElement :: Element a -> Node a +nodeElement = + liftAlt . AST.NodeElement + +nodeText :: Text a -> Node a +nodeText = + liftAlt . AST.NodeText diff --git a/library/XMLQuery/AST.hs b/library/XMLQuery/AST.hs new file mode 100644 --- /dev/null +++ b/library/XMLQuery/AST.hs @@ -0,0 +1,45 @@ +-- | +-- An API for the implementation of interpreters. +-- Should only be used by the libraries, which implement the interpreters. +module XMLQuery.AST +where + +import XMLQuery.Prelude hiding (Text) +import qualified XMLQuery.Prelude as Prelude + + +data Text a = + Text (Prelude.Text -> Either Prelude.Text a) + +deriving instance Functor Text + + +data Element a = + ElementNameText (Alt Text a) | + ElementAttr (Alt Attr a) | + ElementNodes (Alt Nodes a) + +deriving instance Functor Element + + +data Attr a = + AttrNameText (Alt Text a) | + AttrValueText (Alt Text a) + +deriving instance Functor Attr + + +data Nodes a = + NodesNode (Alt Node a) + +deriving instance Functor Nodes + + +data Node a = + NodeElement (Alt Element a) | + NodeText (Alt Text a) + +deriving instance Functor Node + + + diff --git a/library/XMLQuery/Prelude.hs b/library/XMLQuery/Prelude.hs new file mode 100644 --- /dev/null +++ b/library/XMLQuery/Prelude.hs @@ -0,0 +1,20 @@ +module XMLQuery.Prelude +( + module Exports, +) +where + + +-- base-prelude +------------------------- +import BasePrelude as Exports hiding (fail, Alt) + +-- text +------------------------- +import Data.Text as Exports (Text) + +-- free +------------------------- +import Control.Alternative.Free as Exports +import Control.Monad.Free as Exports hiding (Pure) +import Control.Monad.Free.TH as Exports diff --git a/xml-query.cabal b/xml-query.cabal new file mode 100644 --- /dev/null +++ b/xml-query.cabal @@ -0,0 +1,65 @@ +name: + xml-query +version: + 0.9.0.2 +synopsis: + A parser-agnostic declarative API for querying XML-documents +description: + Provides an API for definitition of destructuring of XML-documents, + while delegating the actual parsing process to outer APIs. + Thus it allows the users to implement parser-agnostic XML-parsing specifications, + with the intent of later interpreting them with specific parsers + or documentation generators, or what not. + . + Following are the known interpreters: + . + * + . + * +category: + Data, XML, Parsing +homepage: + https://github.com/sannsyn/xml-query +bug-reports: + https://github.com/sannsyn/xml-query/issues +author: + Nikita Volkov +maintainer: + Nikita Volkov +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.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.Prelude + exposed-modules: + XMLQuery.AST + XMLQuery + build-depends: + -- + text == 1.*, + -- + free >= 4.12 && < 5, + base-prelude >= 0.1.19 && < 0.2