regular-xmlpickler (empty) → 0.1

raw patch · 6 files changed

+199/−0 lines, 6 filesdep +basedep +hxtdep +regularsetup-changed

Dependencies added: base, hxt, regular

Files

• LICENSE +28/−0
• Setup.lhs +6/−0
• regular-xmlpickler.cabal +22/−0
• src/Generics/Regular/XmlPickler.hs +19/−0
• src/Generics/Regular/XmlPickler/Function.hs +84/−0
• src/Generics/Regular/XmlPickler/Instances.hs +40/−0

@@ -0,0 +1,28 @@+Copyright (c) 2009 Universiteit Utrecht+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 Universiteit Utrecht 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 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.+

@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++>import Distribution.Simple++>main = defaultMain+

@@ -0,0 +1,22 @@+Name:             regular-xmlpickler+Version:          0.1+Description:      Generic generation of HXT XmlPickler instances using Regular.+Synopsis:         Generic generation of HXT XmlPickler instances using Regular.+Category:         XML, Data+Cabal-Version:    >= 1.6+Author:           typLAB+Copyright:        (c) 2009, typLAB+Maintainer:       code@typlab.com+Homepage:         http://github.com/typLAB/regular-xmlpickler+License:          BSD3+License-File:     LICENSE+Build-Type:       Simple+Build-Depends:    base == 4.*,+                  hxt ==8.3.*,+                  regular == 0.2.*++HS-Source-Dirs:   src+GHC-Options:      -Wall -fno-warn-orphans+Exposed-Modules:  Generics.Regular.XmlPickler,+                  Generics.Regular.XmlPickler.Function,+                  Generics.Regular.XmlPickler.Instances

@@ -0,0 +1,19 @@+-------------------------------------------------------------------------------+-- |+-- Module : Generics.Regular.XmlPickler+-- Copyright : (c) 2009, typLAB+-- License : BSD3+--+-- Maintainer : typLAB <code@typlab.com>+-- Stability : Experimental+--+-- Generic 'XmlPickler'. This module allows you to generically convert+-- your datatype to and from XML. If you don't want the (G)XmlPickler+-- instances for 'Bool' and 'String', use+-- 'Generic.Regular.XmlPickler.Function' instead.+--+-------------------------------------------------------------------------------+module Generics.Regular.XmlPickler (gxpickle, GXmlPickler(..)) where++import Generics.Regular.XmlPickler.Function+import Generics.Regular.XmlPickler.Instances()

@@ -0,0 +1,84 @@+{-# LANGUAGE+    TypeOperators+  , FlexibleContexts+  , ScopedTypeVariables+  #-}+-------------------------------------------------------------------------------+-- |+-- Module : Generics.Regular.XmlPickler.Function+-- Copyright : (c) 2009, typLAB+-- License : BSD3+--+-- Maintainer : typLAB <code@typlab.com>+-- Stability : Experimental+--+-- Generic XmlPickler. Use this module if you don't want the instances+-- from Generics.Regular.XmlPickler.Instances.+--+-------------------------------------------------------------------------------+module Generics.Regular.XmlPickler.Function (gxpickle, GXmlPickler(..)) where++import Data.Char (toLower)+import Generics.Regular+import Text.XML.HXT.Arrow+import Text.XML.HXT.Arrow.Pickle.Schema++-- | The generic XmlPickler class. This gives generic xml picklers for+-- the functors from 'Generics.Regular'. These are usually not used+-- directly.+class GXmlPickler f where+  gxpicklef :: PU a -> PU (f a)++instance GXmlPickler I where+  gxpicklef = xpWrap (I, unI)++instance XmlPickler a => GXmlPickler (K a) where+  gxpicklef _ = (K, unK) `xpWrap` xpickle++instance GXmlPickler U where+  gxpicklef _ = (const U, const ()) `xpWrap` xpUnit++instance (GXmlPickler f, GXmlPickler g) => GXmlPickler (f :+: g) where+  gxpicklef f = gxpicklef f `xpSum` gxpicklef f++instance (GXmlPickler f, GXmlPickler g) => GXmlPickler (f :*: g) where+  gxpicklef f = (uncurry (:*:), \(a :*: b) -> (a, b)) `xpWrap` (gxpicklef f `xpPair` gxpicklef f)++instance (Constructor c, GXmlPickler f) => GXmlPickler (C c f) where+  gxpicklef f = xpElem (map toLower $ conName (undefined :: C c f r)) ((C, unC) `xpWrap` (gxpicklef f))++instance (Selector s, GXmlPickler f) => GXmlPickler (S s f) where+  gxpicklef f = xpElem (map toLower $ selName (undefined :: S s f r)) ((S, unS) `xpWrap` gxpicklef f)++-- | The generic pickler. Uses a tag for each constructor with the+-- lower case constructor name, and a tag for each record field with+-- the lower case field name. Most values are pickled using their own+-- 'XmlPickler' instance, and 'String's are pickled as possibly empty+-- text nodes.+gxpickle :: (Regular a, GXmlPickler (PF a)) => PU a+gxpickle = (to, from) `xpWrap` gxpicklef gxpickle++-- * Pickling combinators++-- | Combine two picklers into a pickler for 'Either'. While pickling,+-- check if the either is a 'Left' or 'Right' and use the appropriate+-- pickler. During unpickling, first try the first, and if it fails,+-- try the second.+xpEither :: PU a -> PU b -> PU (Either a b)+xpEither ~(PU fl tl sa) ~(PU fr tr sb) = PU+  (\(x, st) -> case x of+                 Left  y -> fl (y, st)+                 Right y -> fr (y, st))+  (\x -> case tl x of+           (Nothing, _) -> lmap (fmap Right) (tr x)+           r            -> lmap (fmap Left) r)+  (sa `scAlt` sb)+  where lmap f (a, b) = (f a, b)++xpSum :: PU (f r) -> PU (g r) -> PU ((f :+: g) r)+xpSum l r = (i, o) `xpWrap` xpEither l r+  where+    i (Left  x) = L x+    i (Right x) = R x+    o (L x) = Left x+    o (R x) = Right x

@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleInstances #-}+-------------------------------------------------------------------------------+-- |+-- Module : Generics.Regular.XmlPickler+-- Copyright : (c) 2009, typLAB+-- License : BSD3+--+-- Maintainer : typLAB <code@typlab.com>+-- Stability : Experimental+--+-- 'XmlPickler' instance for 'Bool' which converts to and from the Strings+-- \"true\" and \"false\", and 'GXmlPickler' instance for 'K' 'String', which+-- allows whitespace. These instances are automatically used if you+-- import 'Generics.Regular.XmlPickler'.+--+-------------------------------------------------------------------------------+module Generics.Regular.XmlPickler.Instances() where++import Generics.Regular+import Generics.Regular.XmlPickler.Function+import Text.XML.HXT.Arrow++-- * Boolean instance for XmlPickler.++instance XmlPickler Bool where+  xpickle = (toBool, fromBool) `xpWrap` xpText++toBool :: String -> Bool+toBool "true"  = True+toBool "false" = False+toBool _       = error "No parse for bool in toBool (XmlPickler)."++fromBool :: Bool -> String+fromBool True  = "true"+fromBool False = "false"++-- * GXmlPickler instance for String.++instance GXmlPickler (K String) where+  gxpicklef _ = (K, unK) `xpWrap` xpText0