hexpat-pickle-generic (empty) → 0.1.0

raw patch · 5 files changed

+303/−0 lines, 5 filesdep +basedep +bytestringdep +hexpat-picklesetup-changed

Dependencies added: base, bytestring, hexpat-pickle, text

Files

LICENSE +29/−0
README.md +37/−0
Setup.hs +2/−0
hexpat-pickle-generic.cabal +40/−0
src/Text/XML/Expat/Pickle/Generic.hs +195/−0

+ LICENSE view

@@ -0,0 +1,29 @@+Copyright (c) 2013 Brendan Hay+Initial non-GHC.Generics implementation Copyright (c) 2009 typLAB++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.

+ README.md view

@@ -0,0 +1,37 @@+## hexpat-generic-pickle++[![Build Status](https://secure.travis-ci.org/brendanhay/hexpat-generic-pickle.png)](http://travis-ci.org/brendanhay/hexpat-generic-pickle)+++## Table of Contents++* [Introduction](#introduction)+* [Examples](#examples)+* [Compatibility](#compatibility)+* [Contributing](#contributing)+* [Licence](#licence)+++## Introduction++> TODO+++## Examples++> TODO+++## Compatibility++> TODO+++## Contributing++For any problems, comments or feedback please create an issue [here on GitHub](github.com/brendanhay/hexpat-generic-pickle/issues).+++## Licence++hexpat-generic-pickle is released under the [Mozilla Public License Version 2.0](http://www.mozilla.org/MPL/)

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ hexpat-pickle-generic.cabal view

@@ -0,0 +1,40 @@+name:                  hexpat-pickle-generic+version:               0.1.0+synopsis:              Picklers for de/serialising Generic data types to and from XML+license:               BSD3+license-file:          LICENSE+author:                Brendan Hay+maintainer:            Brendan Hay <brendan.g.hay@gmail.com>+copyright:             Copyright (c) 2013 Brendan Hay+stability:             Experimental+category:              Data, XML+build-type:            Simple+cabal-version:         >= 1.10++description:+    An IsXML class and GHC.Generics implementation for pickleable+    data types using hexpat and hexpat-pickle.++extra-source-files:+    README.md++source-repository head+    type:     git+    location: git://github.com/brendanhay/hexpat-pickle-generic.git++library+    default-language:  Haskell2010+    hs-source-dirs:    src++    exposed-modules:+        Text.XML.Expat.Pickle.Generic++    ghc-options:+        -Wall+        -O2++    build-depends:+        base          >= 4.6 && < 5+      , bytestring+      , hexpat-pickle+      , text

+ src/Text/XML/Expat/Pickle/Generic.hs view

@@ -0,0 +1,195 @@+{-# LANGUAGE DefaultSignatures               #-}+{-# LANGUAGE FlexibleContexts                #-}+{-# LANGUAGE FlexibleInstances               #-}+{-# LANGUAGE MultiParamTypeClasses           #-}+{-# LANGUAGE OverloadedStrings               #-}+{-# LANGUAGE ScopedTypeVariables             #-}+{-# LANGUAGE TypeOperators                   #-}+{-# LANGUAGE ViewPatterns                    #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-- Module      : Text.XML.Expat.Pickle.Generic+-- Copyright   : (c) 2013 Brendan Hay <brendan.g.hay@gmail.com>+-- License     : This Source Code Form is subject to the terms of+--               Berkeley Software Distribution License, v. 3.0.+--               You can obtain it at+--               http://http://opensource.org/licenses/BSD-3-Clause.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)++module Text.XML.Expat.Pickle.Generic+    (+    -- * Class+      IsXML   (..)++    -- * Functions+    , encode+    , decode+    , decodeEither++    -- * Re-exported Data Types+    , PU      (..)++    -- * Options+    , Options (..)+    , defaultOptions++    -- * Generics+    , genericXMLPickler++    -- * Combinators+    , xpSum+    , xpEither+    , xpGenericString++    -- * Re-exported Combinators+    , xpText0+    , xpText+    , xpList0+    , xpList+    , xpContent+    , xpPrim+    , xpWrap+    ) where++import           Data.ByteString       (ByteString)+import           Data.Char             (isLower)+import           Data.Text             (Text)+import           GHC.Generics+import qualified Text.XML.Expat.Pickle as Pickle+import           Text.XML.Expat.Pickle hiding (xpPrim)++--+-- Class+--++class IsXML a where+    xmlPickler :: PU [UNode ByteString] a++    default xmlPickler :: (Generic a, GIsXML [UNode ByteString] (Rep a))+                      => PU [UNode ByteString] a+    xmlPickler = genericXMLPickler defaultOptions++--+-- Functions+--++encode :: IsXML a => a -> ByteString+encode = pickleXML' (xpRoot xmlPickler)++decode :: IsXML a => ByteString -> Maybe a+decode = either (const Nothing) Just . decodeEither++decodeEither :: IsXML a => ByteString -> Either String a+decodeEither = unpickleXML' defaultParseOptions (xpRoot xmlPickler)++--+-- Defining Picklers+--++data Options = Options+    { constructorTagModifier :: String -> String+      -- ^ Function applied to constructor tags.+    , fieldLabelModifier     :: String -> String+      -- ^ Function applied to record field labels.+    }++defaultOptions :: Options+defaultOptions = Options id (dropWhile isLower)++--+-- Generics+--++genericXMLPickler opts =+    (to, from) `xpWrap` (gXMLPickler opts) (genericXMLPickler opts)++class GIsXML t f where+    gXMLPickler :: Options -> PU t a -> PU t (f a)++instance IsXML a => GIsXML [UNode ByteString] (K1 i a) where+    gXMLPickler _ _ = (K1, unK1) `xpWrap` xmlPickler++instance GIsXML [t] U1 where+    gXMLPickler _ _ = (const U1, const ()) `xpWrap` xpUnit++instance (GIsXML t f, GIsXML t g) => GIsXML t (f :+: g) where+    gXMLPickler opts f = gXMLPickler opts f `xpSum` gXMLPickler opts f++instance (GIsXML [t] f, GIsXML [t] g) => GIsXML [t] (f :*: g) where+    gXMLPickler opts f = xpWrap+        (uncurry (:*:), \(a :*: b) -> (a, b))+        (gXMLPickler opts f `xpPair` gXMLPickler opts f)++instance (Datatype d, GIsXML t f) => GIsXML t (M1 D d f) where+    gXMLPickler opts = xpWrap (M1, unM1) . gXMLPickler opts++instance (Constructor c, GIsXML [UNode ByteString] f)+         => GIsXML [UNode ByteString] (M1 C c f) where+    gXMLPickler opts f = xpElemNodes+        (gxFromString . constructorTagModifier opts $ conName (undefined :: M1 C c f r))+        ((M1, unM1) `xpWrap` gXMLPickler opts f)++instance (Selector s, GIsXML [UNode ByteString] f)+         => GIsXML [UNode ByteString] (M1 S s f) where+    gXMLPickler opts f = xpElemNodes+        (gxFromString . fieldLabelModifier opts $ selName (undefined :: M1 S s f r))+        ((M1, unM1) `xpWrap` gXMLPickler opts f)++--+-- Combinators+--++xpPrim :: (Read b, Show b, GenericXMLString t) => PU [Node a t] b+xpPrim = xpContent Pickle.xpPrim++xpSum :: PU t (f r) -> PU t (g r) -> PU t ((f :+: g) r)+xpSum left right = (inp, out) `xpWrap` xpEither left right+  where+    inp (Left  x) = L1 x+    inp (Right x) = R1 x++    out (L1 x) = Left x+    out (R1 x) = Right x++xpEither :: PU t a -> PU t b -> PU t (Either a b)+xpEither ~(PU _ uea pa) ~(PU ub ueb pb) =+    PU unpickle unpickleEither pickle+  where+    unpickle t = case uea t of+        Right x -> Left x+        Left  _ -> Right $ ub t++    unpickleEither t = case uea t of+        Right x -> Right . Left $ x+        Left  _ -> Right `fmap` ueb t++    pickle (Left x)  = pa x+    pickle (Right y) = pb y++xpGenericString :: GenericXMLString t => PU [UNode ByteString] t+xpGenericString = (gxFromByteString, gxToByteString) `xpWrap` xpContent xpText0++--+-- Instances+--++instance IsXML Int where+    xmlPickler = xpPrim++instance IsXML Integer where+    xmlPickler = xpPrim++instance IsXML Text where+    xmlPickler = xpGenericString++instance IsXML ByteString where+    xmlPickler = xpGenericString++instance IsXML a => IsXML (Maybe a) where+    xmlPickler = xpOption xmlPickler++instance IsXML a => IsXML [a] where+    xmlPickler = xpList0 xmlPickler