roundtrip-string (empty) → 0.1.0.0

raw patch · 5 files changed

+205/−0 lines, 5 filesdep +basedep +mtldep +parsecsetup-changed

Dependencies added: base, mtl, parsec, roundtrip

Files

LICENSE +30/−0
Setup.hs +2/−0
roundtrip-string.cabal +28/−0
src/Text/Roundtrip/Parser.hs +77/−0
src/Text/Roundtrip/Printer.hs +68/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2011 factis research GmbH++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 offactis research GmbH 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.

+ Setup.hs view

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

+ roundtrip-string.cabal view

@@ -0,0 +1,28 @@+Name:           roundtrip-string+Version:        0.1.0.0+Synopsis:       Bidirectional (de-)serialization+Description:    Roundtrip allows the definition of bidirectional+                (de-)serialization specifications. This package provides+                concrete implementations of these specifications+                for parsing/pretty-printing strings.+                .+                See the roundtrip package for more details.+License:        BSD3+License-file:   LICENSE+Author:         Stefan Wehr <wehr@factisresearch.com>,+                David Leuschner <leuschner@factisresearch.com>+Maintainer:     Stefan Wehr <wehr@factisresearch.com>,+Category:       Text+Build-type:     Simple+Cabal-version:  >=1.8++Library+  Hs-Source-Dirs: src+  Exposed-modules:+      Text.Roundtrip.Parser+    , Text.Roundtrip.Printer+  Build-depends:+      base == 4.*+    , mtl >= 1.1.1.1+    , parsec == 3.1.*+    , roundtrip == 0.2.*

+ src/Text/Roundtrip/Parser.hs view

@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances #-}+module Text.Roundtrip.Parser (++  module Text.Parsec, Pos.newPos, Pos.initialPos,++  PParser, parsecApply, parsecConcat, parsecAlternative1Lookahead,+  parsecAlternativeInfLookahead, parsecEmpty, parsecPure,++  runStringParser, P.runParser, mkParseError++) where++import Control.Monad.Identity (Identity, runIdentity)++import Text.Parsec hiding (runParser)+import qualified Text.Parsec as P+import Text.Parsec.Char+import qualified Text.Parsec.Pos as Pos+import qualified Text.Parsec.Prim as Prim+import qualified Text.Parsec.Error as Perror+import Text.Parsec.Prim ()++import Text.Roundtrip++type PParser s u m = ParsecT s u m++parsecApply :: Iso a b -> PParser s u m a -> PParser s u m b+parsecApply iso p =+    do a <- p+       case apply iso a of+         Just b -> return b+         Nothing -> fail $ isoFailedErrorMessageL iso a++parsecConcat :: PParser s u m a -> PParser s u m b -> PParser s u m (a, b)+parsecConcat p q =+    do x <- p+       y <- q+       return (x, y)++parsecAlternative1Lookahead :: PParser s u m a -> PParser s u m a -> PParser s u m a+parsecAlternative1Lookahead p q = p P.<|> q++parsecAlternativeInfLookahead :: PParser s u m a -> PParser s u m a -> PParser s u m a+parsecAlternativeInfLookahead p q = try p P.<|> q++parsecEmpty :: PParser s u m a+parsecEmpty = parserZero++parsecPure :: a -> PParser s u m a+parsecPure x = return x++instance Monad m => IsoFunctor (PParser s u m) where+    (<$>) = parsecApply++instance Monad m => ProductFunctor (PParser s u m) where+    (<*>) = parsecConcat++instance Monad m => Alternative (PParser s u m) where+    (<|>) = parsecAlternative1Lookahead+    (<||>) = parsecAlternativeInfLookahead+    empty = parsecEmpty++instance Monad m => Syntax (PParser s u m) where+    pure = parsecPure++instance (Monad m, Stream s m Char) => StringSyntax (PParser s u m) where+    token f = Prim.tokenPrim showChar nextPos testChar+        where+          showChar x      = '\'' : x : ['\'']+          testChar x      = if f x then Just x else Nothing+          nextPos pos x _ = Pos.updatePosChar pos x++runStringParser :: Stream s Identity Char => PParser s () Identity a -> SourceName -> s -> Either ParseError a+runStringParser p src s = runIdentity $ Prim.runParserT p () src s++mkParseError :: SourcePos -> String -> ParseError+mkParseError pos msg = Perror.newErrorMessage (Perror.Message msg) pos

+ src/Text/Roundtrip/Printer.hs view

@@ -0,0 +1,68 @@+{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}+module Text.Roundtrip.Printer (++  Printer(..),+  printerApply, printerConcat, printerAlternative, printerEmpty,+  printerPure, runPrinter, runStringPrinter++) where++import Control.Monad.Identity (Identity, runIdentity)++import Data.Monoid++import Text.Roundtrip++newtype Printer m r a = Printer { unPrinter :: a -> m (Maybe r) }++instance Monad m => IsoFunctor (Printer m r) where+    (<$>) = printerApply++printerApply :: Monad m => Iso a b -> Printer m r a -> Printer m r b+printerApply iso (Printer p) = Printer $ \b ->+    case unapply iso b of+      Just x -> p x+      Nothing -> return Nothing++instance (Monad m, Monoid r) => ProductFunctor (Printer m r) where+    (<*>) = printerConcat++printerConcat :: (Monoid r, Monad m) => Printer m r a -> Printer m r b -> Printer m r (a, b)+printerConcat (Printer p) (Printer q) = Printer $ \(a, b) ->+    do ma <- p a+       case ma of+         Nothing -> return Nothing+         Just !ea -> do mb <- q b+                        case mb of+                          Nothing -> return Nothing+                          Just eb -> return (Just (ea `mappend` eb))++instance Monad m => Alternative (Printer m r) where+    (<|>) = printerAlternative+    (<||>) = printerAlternative+    empty = printerEmpty++printerEmpty :: Monad m => Printer m r a+printerEmpty = Printer $ \_ -> return Nothing++printerAlternative :: Monad m => Printer m r a -> Printer m r a -> Printer m r a+printerAlternative (Printer p) (Printer q) = Printer $ \a ->+    do ma <- p a+       case ma of+         Nothing -> q a+         Just ea -> return (Just ea)++instance (Monad m, Monoid r) => Syntax (Printer m r) where+    pure = printerPure++printerPure :: (Monad m, Monoid r, Eq a) => a -> Printer m r a+printerPure x = Printer $ \y -> if x == y then return (Just mempty) else return Nothing++instance Monad m => StringSyntax (Printer m String) where+  token f = Printer $ \c -> return (if f c then Just [c] else Nothing)++runPrinter :: Printer Identity r a -> a -> Maybe r+runPrinter (Printer p) x = runIdentity (p x)++runStringPrinter :: Printer Identity String a -> a -> Maybe String+runStringPrinter = runPrinter