repr 0.3 → 0.3.1
raw patch · 2 files changed
+74/−15 lines, 2 files
Files
- Text/Repr.hs +73/−14
- repr.cabal +1/−1
Text/Repr.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Text.Repr@@ -53,11 +54,27 @@ ) import Data.Fixed ( HasResolution, resolution ) import Data.Ix ( Ix, range, index, inRange, rangeSize )+import Foreign.Storable ( Storable+ , sizeOf+ , alignment+ , peekElemOff+ , pokeElemOff+ , peekByteOff+ , pokeByteOff+ , peek+ , poke+ )+import Foreign.Ptr ( castPtr )+import Data.Typeable ( Typeable, typeOf) import System.Random ( Random, randomR, random ) import Control.Applicative ( liftA2 ) import Control.Arrow ( first ) +#if MIN_VERSION_base(4,0,0)+import Control.Exception ( Exception, toException, fromException )+#endif + -------------------------------------------------------------------------------- -- Repr --------------------------------------------------------------------------------@@ -65,6 +82,9 @@ {-| @Repr a@ is a value of type @a@ paired with a way to render that value to its textual representation. +@Repr@s follow the property that given a @Repr@ @r@ if you evaluate the textual+representation of @r@ you should get the value or @r@.+ Note that @Repr a@ has an instance for most classes in 'base' provided that @a@ has instances for the respected classes. This allows you to write a numeric expression of type @Repr a@. For example:@@ -98,11 +118,11 @@ <http://haskell.org/onlinereport/decls.html#sect4.4.2> -The reason the renderer returns a 'DString', instead of for example a 'String',-is that the rendering of numeric expression involves lots of left-factored-appends i.e.: @((a ++ b) ++ c) ++ d@. A 'DString' has a O(1) append operation-while a 'String' just has a O(n) append. So choosing a 'DString' is more-efficient.+The reason the renderer returns a 'DString', instead of for example a 'String'+has to do with efficiency. The rendering of expressions involves lots of+left-factored appends i.e.: @((a ++ b) ++ c) ++ d@. A 'DString', which is+equivalent to a 'ShowS', has a O(1) append operation while a 'String' has a O(n)+append. -} type Renderer = Precedence -> Fixity -> DString @@ -151,7 +171,7 @@ @ -} (<?>) :: Repr a -> DString -> Repr a-(Repr x rx) <?> s = constant x $ paren (between "{- " " -}" s <+> topLevel rx)+(Repr x rx) <?> s = constant x $ topLevel rx `annotateWith` s {-| @pure x@ constructs a 'Repr' which has @x@ as value and the showed @x@ as rendering. For example:@@ -165,7 +185,7 @@ @ -} pure :: Show a => a -> Repr a-pure x = Repr x $ \prec _ -> showsPrecDS prec x+pure x = Repr x $ \prec _ -> fromShowS $ showsPrec prec x --------------------------------------------------------------------------------@@ -329,6 +349,43 @@ inRange (b, e) p = inRange (extract b, extract e) (extract p) rangeSize (b, e) = rangeSize (extract b, extract e) +instance (Show a, Storable a) => Storable (Repr a) where+ sizeOf = to sizeOf+ alignment = to alignment++ peekElemOff rPtr off = do+ x <- peekElemOff (castPtr rPtr) off+ return $ pure x <?> ("peekElemOff" <+> showFuncArg rPtr <+> showFuncArg off)++ peekByteOff ptr off = do+ x <- peekByteOff ptr off+ return $ pure x <?> ("peekByteOff" <+> showFuncArg ptr <+> showFuncArg off)++ peek rPtr = do+ x <- peek (castPtr rPtr)+ return $ pure x <?> ("peek" <+> showFuncArg rPtr)++ poke rPtr r = poke (castPtr rPtr) (extract r)+ pokeElemOff rPtr off r = pokeElemOff (castPtr rPtr) off (extract r)+ pokeByteOff ptr off r = pokeByteOff ptr off (extract r)++instance Typeable a => Typeable (Repr a) where+ typeOf = to typeOf++#if MIN_VERSION_base(4,0,0)+instance Exception a => Exception (Repr a) where+ toException = to toException+ fromException se =+ fmap (\x -> pure x <?> ( "fromJust"+ <+> paren ( "fromException"+ <+> paren ( "toException"+ <+> paren (showFuncArg x)+ )+ )+ )+ ) $ fromException se+#endif+ instance (Random a, Show a) => Random (Repr a) where randomR (b, e) = first pure . randomR (extract b, extract e) random = first pure . random@@ -338,24 +395,25 @@ -- Utility functions -------------------------------------------------------------------------------- +annotateWith :: DString -> DString -> DString+s `annotateWith` a = paren $ between "{- " " -}" a <+> s+ topLevel :: Renderer -> DString topLevel r = r 0 Non constant :: a -> DString -> Repr a constant x xStr = Repr x $ \_ _ -> xStr -showsPrecDS :: Show a => Precedence -> a -> DString-showsPrecDS prec = fromShowS . showsPrec prec+showFuncArg :: Show a => a -> DString+showFuncArg = fromShowS . showsPrec funAppPrec from :: Show a => (a -> b) -> DString -> (a -> Repr b) from f fStr =- \x -> Repr (f x) $ fStr `apply` showsPrecDS funAppPrec x+ \x -> Repr (f x) $ fStr `apply` showFuncArg x from2 :: (Show a, Show b) => (a -> b -> c) -> DString -> (a -> b -> Repr c) from2 f fStr =- \x y -> Repr (f x y) $ fStr `apply`( showsPrecDS funAppPrec x- <+> showsPrecDS funAppPrec y- )+ \x y -> Repr (f x y) $ fStr `apply`(showFuncArg x <+> showFuncArg y) to :: (a -> b) -> (Repr a -> b) to f = f . extract@@ -374,7 +432,8 @@ app2Show :: Show b => (a -> b -> a) -> DString -> (Repr a -> b -> Repr a) app2Show f fStr = \(Repr x rx) y ->- Repr (f x y) (fStr `applies` [rx, \prec _ -> showsPrecDS prec y])+ Repr (f x y)+ (fStr `applies` [rx, \prec _ -> fromShowS $ showsPrec prec y]) infx :: Fixity -> Precedence -> (a -> b -> c) -> DString -> (Repr a -> Repr b -> Repr c)
repr.cabal view
@@ -1,5 +1,5 @@ name: repr-version: 0.3+version: 0.3.1 cabal-version: >= 1.6 build-type: Simple stability: experimental