invertible-hxt (empty) → 0.1

raw patch · 3 files changed

+151/−0 lines, 3 filesdep +basedep +hxtdep +hxt-charproperties

Dependencies added: base, hxt, hxt-charproperties, invertible, mtl

Files

LICENSE +30/−0
Text/XML/HXT/Arrow/Pickle/Xml/Invertible.hs +92/−0
invertible-hxt.cabal +29/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2016-2017, Dylan Simon++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Dylan Simon nor the names of other+      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+OWNER 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.

+ Text/XML/HXT/Arrow/Pickle/Xml/Invertible.hs view

@@ -0,0 +1,92 @@+-- |Allow combining 'PU's using "Control.Invertible.Monoidal".+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Text.XML.HXT.Arrow.Pickle.Xml.Invertible+  ( module Text.XML.HXT.Arrow.Pickle.Xml+  , module Control.Invertible.Monoidal+  , xpWhitespace+  , xpTrim+  , xpAnyCont+  , xpAnyAttrs+  , xpAny+  , xpAnyElem+  ) where++import           Control.Invertible.Monoidal+import           Control.Monad.State.Class (modify, state)+import           Data.Char.Properties.XMLCharProps (isXmlSpaceChar)+import qualified Data.Invertible as Inv+import           Data.List (partition)+import           Data.Void (absurd)+import           Text.XML.HXT.Arrow.Pickle.Schema (Schema(Any), scEmpty, scSeq, scAlt, scNull)+import           Text.XML.HXT.Arrow.Pickle.Xml+import qualified Text.XML.HXT.Core as HXT+import qualified Text.XML.HXT.DOM.XmlNode as XN++instance Inv.Functor PU where+  fmap (f Inv.:<->: g) p = PU -- xpWrap+    { appPickle = appPickle p . g+    , appUnPickle = fmap f $ appUnPickle p+    , theSchema = theSchema p+    }++instance Monoidal PU where+  unit = xpUnit+  p >*< q = PU -- xpPair+    { appPickle = \(a, b) -> appPickle p a . appPickle q b+    , appUnPickle = do+        a <- appUnPickle p +        b <- appUnPickle q+        return (a, b)+    , theSchema = theSchema p `scSeq` theSchema q+    }++instance MonoidalAlt PU where+  zero = PU+    { appPickle = \a _ -> absurd a+    , appUnPickle = throwMsg "PU.zero"+    , theSchema = scNull+    }+  p >|< q = PU+    { appPickle = either (appPickle p) (appPickle q)+    , appUnPickle = mchoice (Left <$> appUnPickle p) return (Right <$> appUnPickle q)+    , theSchema = theSchema p `scAlt` theSchema q+    }++-- |Ignore any whitespace and produce nothing+xpWhitespace :: PU ()+xpWhitespace = PU+  { appPickle = const id+  , appUnPickle = modify $ \s -> s{ contents = dropWhile (any (all isXmlSpaceChar) . XN.getText) $ contents s }+  , theSchema = scEmpty+  }++-- |Ignore leading whitespace+xpTrim :: PU a -> PU a+xpTrim = (xpWhitespace *<)++-- |Like 'xpTrees' but more efficient+xpAnyCont :: PU HXT.XmlTrees+xpAnyCont = PU+  { appPickle = \c s -> s{ contents = c ++ contents s }+  , appUnPickle = state $ \s -> (contents s, s{ contents = [] })+  , theSchema = Any -- XXX+  }++-- |All attributes+xpAnyAttrs :: PU HXT.XmlTrees+xpAnyAttrs = PU+  { appPickle = \a s -> s{ attributes = a ++ attributes s }+  , appUnPickle = state $ \s -> (attributes s, s{ attributes = [] })+  , theSchema = Any -- XXX+  }++-- |Any content and attributes: combine 'xpAnyCont' and 'xpAnyAttrs'+xpAny :: PU HXT.XmlTrees+xpAny = (uncurry (++) Inv.:<->: partition XN.isAttr) >$< (xpAnyAttrs >*< xpAnyCont)++-- |Any single element+xpAnyElem :: PU HXT.XmlTree+xpAnyElem = xpWrapEither +  ( \e -> if XN.isElem e then Right e else Left "xpAnyElem: any element expected"+  , id+  ) xpTree

+ invertible-hxt.cabal view

@@ -0,0 +1,29 @@+name:                invertible-hxt+version:             0.1+synopsis:            invertible transformer instances for HXT Picklers+description:         Provides alternative syntax for HXT's Picklers (XML parser/generators) based on generic invertible Monoidal+license:             BSD3+license-file:        LICENSE+author:              Dylan Simon+maintainer:          dylan@dylex.net+copyright:           2017+category:            Composition, XML+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC == 7.10.3, GHC == 8.0.1++source-repository head+  type: git+  location: https://github.com/dylex/invertible++library+  exposed-modules:+    Text.XML.HXT.Arrow.Pickle.Xml.Invertible+  build-depends:+    base >= 4.8 && <5,+    mtl,+    hxt,+    hxt-charproperties,+    invertible+  default-language:    Haskell2010+  ghc-options: -Wall