repr 0.2 → 0.3
raw patch · 3 files changed
+435/−382 lines, 3 filesdep +random
Dependencies added: random
Files
- Repr.hs +0/−374
- Text/Repr.hs +426/−0
- repr.cabal +9/−8
− Repr.hs
@@ -1,374 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Repr- ( Repr- , value- , renderer- , Renderer- , Precedence- , Fixity(..)- , render- , (<?>)- ) where-------------------------------------------------------------------------------------- Imports-----------------------------------------------------------------------------------import Data.String ( IsString, fromString )-import Data.String.ToString ( ToString, toString )-import Data.String.Combinators ( (<>)- , (<+>)- , between- , paren- , thenParen- , fromShow- , integer- , int- , hsep- )-import Data.DString ( DString, fromShowS )-import Control.Applicative ( liftA2 )-------------------------------------------------------------------------------------- Repr-----------------------------------------------------------------------------------{-| @Repr a@ is a value of type @a@ paired with a way to render that-value to a string which will contain a representation of the value.--Note that @Repr a@ is overloaded for all the numeric classes provided that-@a@ has instances for the respected classes. This allows you to write a-numeric expression of type @Repr a@. For example:--@-*Repr> let r = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double-@--You can extract the value of @r@:--@-*Repr> value r-17.281195923884734-@--And you can than render @r@ to its textual representation:--@-*Repr> render r-\"fromRational (3 % 2) + fromInteger 2 + (fromInteger 3 + negate (fromInteger 4) * (fromInteger 5 - pi / sqrt (fromInteger 6)))\"-@--}-data Repr a = S { value :: a -- ^ Extract the value of the @Repr@.- , renderer :: Renderer -- ^ Extrac the renderer of the @Repr@.- }--{-| To render you need to supply the precedence and fixity of the-enclosing context.--(For rendering /top-level/ values see 'render'.)--For more documentation about precedence and fixity see:--<http://haskell.org/onlinereport/decls.html#sect4.4.2>--The reason the renderer returns a 'DString', instead of a 'String' for example,-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.--}-type Renderer = Precedence -> Fixity -> DString--{-| The precedence of operators and function application.-- * Operators usually have a precedence in the range of 0 to 9.-- * Function application always has precedence 10.--}-type Precedence = Int---- | Precedence of function application.-funAppPrec :: Precedence-funAppPrec = 10---- | Fixity of operators.-data Fixity = Non -- ^ No fixity information.- | L -- ^ Left associative operator.- | R -- ^ Right associative operator.- deriving Eq--{-| Render a /top-level/ value to a 'String'. Note that:--@-render r = 'toString' $ 'renderer' r 0 'Non'-@--}-render :: Repr a -> String-render r = toString $ renderer r 0 Non--{-| @x \<?\> s@ annotates the rendering with the given string.--The rendering wil look like: @\"({\- s -\} ...)\"@ where @...@ is the rendering-of @x@.--This combinator is handy when you want to render the ouput of a-function and you want to see how the parameters of the function-contribute to the result. For example, suppose you defined the-following function @f@:--@-f p0 p1 p2 = p0 ^ 2 + sqrt p1 * ([p2..] !! 10)-@--You can then apply @f@ to some parameters annotated with some descriptive-strings (the name of the parameter is usally a good idea):--@-f (1 \<?\> \"p0\") (2 \<?\> \"p1\") (3 \<?\> \"p2\")-@--The rendering will then look like:--@-\"({\- p0 -\} fromInteger 1) * ({\- p0 -\} fromInteger 1) + sqrt ({\- p1 -\} (fromInteger 2)) * enumFrom ({\- p2 -\} (fromInteger 3)) !! 10\"-@--}-(<?>) :: Repr a -> DString -> Repr a-(S x rx) <?> s =- S x $ \_ _ -> paren (between "{- " " -}" s <+> rx 0 Non)-------------------------------------------------------------------------------------- Instances-----------------------------------------------------------------------------------instance Show (Repr a) where- show = render--instance Num a => Num (Repr a) where- fromInteger = from fromInteger "fromInteger"- (+) = infx L 6 (+) "+"- (-) = infx L 6 (-) "-"- (*) = infx L 7 (*) "*"- negate = app negate "negate"- abs = app abs "abs"- signum = app signum "signum"--instance Real a => Real (Repr a) where- toRational = to toRational--instance Integral a => Integral (Repr a) where- quot = app2 quot "quot"- rem = app2 rem "rem"- div = app2 div "div"- mod = app2 mod "mod"- quotRem = tup quotRem "quotRem"- divMod = tup divMod "divMod"- toInteger = to toInteger--instance Fractional a => Fractional (Repr a) where- (/) = infx L 7 (*) "/"- recip = app recip "recip"- fromRational = from fromRational "fromRational"--instance Floating a => Floating (Repr a) where- pi = constant pi "pi"- (**) = infx R 8 (**) "**"- logBase = app2 logBase "logBase"- exp = app exp "exp"- sqrt = app sqrt "sqrt"- log = app log "log"- sin = app sin "sin"- tan = app tan "tan"- cos = app cos "cos"- asin = app asin "asin"- atan = app atan "atan"- acos = app acos "acos"- sinh = app sinh "sinh"- tanh = app tanh "tanh"- cosh = app cosh "cosh"- asinh = app asinh "asinh"- atanh = app atanh "atanh"- acosh = app acosh "acosh"--instance RealFrac a => RealFrac (Repr a) where- properFraction (S x rx) =- let (n, f) = properFraction x- in (n, S f $ "snd" `apply` paren ("properFraction" <+> args [rx]))--instance RealFloat a => RealFloat (Repr a) where- floatRadix = to floatRadix- floatDigits = to floatDigits- floatRange = to floatRange- decodeFloat = to decodeFloat- encodeFloat = from2 encodeFloat "encodeFloat"- exponent = to exponent- significand = app significand "significand"- scaleFloat i = app (scaleFloat i) ("scaleFloat" <+> int i)- isNaN = to isNaN- isInfinite = to isInfinite- isDenormalized = to isDenormalized- isNegativeZero = to isNegativeZero- isIEEE = to isIEEE- atan2 = app2 atan2 "atan2"--instance Enum a => Enum (Repr a) where- succ = app succ "succ"- pred = app pred "pred"- toEnum = from toEnum "toEnum"- fromEnum = to fromEnum- enumFrom (S x rx) = enum "From" (enumFrom x) [rx]- enumFromThen (S x rx)- (S y ry) = enum "FromThen" (enumFromThen x y) [rx, ry]- enumFromTo (S x rx)- (S y ry) = enum "FromTo" (enumFromTo x y) [rx, ry]- enumFromThenTo (S x rx)- (S y ry)- (S z rz) = enum "FromThenTo" (enumFromThenTo x y z) [rx, ry, rz]--enum :: DString -> [a] -> [Renderer] -> [Repr a]-enum enumStr xs rxs = zipWith combine [0..] xs- where- combine i y = S y $ bin L 9 "!!" ("enum" <> enumStr <+> args rxs) (integer i)--instance Ord a => Ord (Repr a) where- compare = to2 compare- (<) = to2 (<)- (>=) = to2 (>=)- (>) = to2 (>)- (<=) = to2 (<=)- max = app2 max "max"- min = app2 min "min"--instance Eq a => Eq (Repr a) where- (==) = to2 (==)- (/=) = to2 (/=)--instance IsString a => IsString (Repr a) where- fromString = liftA2 constant fromString fromShow-------------------------------------------------------------------------------------- Utility functions------------------------------------------------------------------------------------- | Construct a 'Repr' from a given value and string.-constant :: a -> DString -> Repr a-constant x xStr = S x $ \_ _ -> xStr--{-| Given a function @f@ and the name of that function @fStr@ return-a function that takes a 'Show'able argument @x@ and returns a 'Repr'-that has @f x@ as value and @fStr@ prepended to the showed @x@ as-renderer .--For example:-@-*Repr> let r = from fromRational "fromRational" 13.4-*Repr> value r-13.4 -- fromRational (67 % 5)-*Repr> render r-"fromRational (67 % 5)"-@--}-from :: Show a => (a -> b) -> DString -> (a -> Repr b)-from f fStr =- \x -> S (f x) $ fStr `apply` fromShowS (showsPrec funAppPrec x)---- | Same as 'from' with the difference that the given function has two arguments.-from2 :: (Show a, Show b) => (a -> b -> c) -> DString -> (a -> b -> Repr c)-from2 f fStr =- \x y -> S (f x y) $ fStr `apply`( fromShowS (showsPrec funAppPrec x)- <+> fromShowS (showsPrec funAppPrec y)- )---- | Return the converted value of the 'Repr'.-to :: (a -> b) -> (Repr a -> b)-to f = f . value---- | Return the combined values of the 'Repr's.-to2 :: (a -> b -> c) -> (Repr a -> Repr b -> c)-to2 f = \x y -> f (value x) (value y)--{-| Given a function @f@ and the name of that function @fStr@ return-a function that takes a @Repr@ and returns a @Repr@ that has as value-@f@ applied to the value of the given @Repr@ and as renderer @fStr@-prepended to the renderer of the given @Repr@.--For example:-@-*Repr> let r = app sqrt "sqrt" 4-*Repr> value r-2.0 -- sqrt (fromInteger 4)-*Repr> render r-"sqrt (fromInteger 4)"-@--}-app :: (a -> b) -> DString -> (Repr a -> Repr b)-app f fStr =- \(S x rx) -> S (f x) $ fStr `apply` args [rx]--{-| Like 'app' but works for binary functions.--For example:-@-*Repr> let r = app2 quot "quot" 4 2-*Repr> value r-2 -- quot (fromInteger 4) (fromInteger 2)-*Repr> render r-"quot (fromInteger 4) (fromInteger 2)"-@--}-app2 :: (a -> b -> c) -> DString -> (Repr a -> Repr b -> Repr c)-app2 f fStr =- \(S x rx) (S y ry) -> S (f x y) $ fStr `apply` args [rx, ry]--{-| Given the fixity, precedence, the actual operator @op@ and the name of the-operator @opStr@ return a function that takes two @Repr@s: @rx@ and @ry@ and-returns a @Repr@ that has as value @value rx `op` value ry@ and as renderer-@opStr@ in between the rendering of @rx@ and @ry@.--For example:-@-*Repr> let r = infx L 6 (+) "+" 2 3-*Repr> value r-5 -- fromInteger 2 + fromInteger 3-*Repr> render r-"fromInteger 2 + fromInteger 3"-@--}-infx :: Fixity -> Precedence -> (a -> b -> c) -> DString- -> (Repr a -> Repr b -> Repr c)-infx opFix opPrec op opStr =- \(S x rx) (S y ry) ->- S (x `op` y) $ bin opFix opPrec opStr (rx opPrec L) (ry opPrec R)--bin :: Fixity -> Precedence -> DString -> DString -> DString -> Renderer-bin opFix opPrec opStr l r = \prec fixity -> (prec > opPrec ||- (prec == opPrec &&- fixity /= Non &&- fixity /= opFix))- `thenParen`- (l <+> opStr <+> r)--apply :: DString -> DString -> Renderer-funStr `apply` argsStr = \prec _ -> (prec >= funAppPrec)- `thenParen`- (funStr <+> argsStr)--args :: [Renderer] -> DString-args = hsep . map (\rx -> rx funAppPrec Non)--tup :: (a -> b -> (c, d)) -> DString- -> (Repr a -> Repr b -> (Repr c, Repr d))-tup f fStr =- \(S x rx) (S y ry) -> let (q, r) = f x y- s = paren (fStr <+> args [rx, ry])- in ( S q $ "fst" `apply` s- , S r $ "snd" `apply` s- )----- The End ---------------------------------------------------------------------
+ Text/Repr.hs view
@@ -0,0 +1,426 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Repr+ ( Repr+ , extract+ , renderer+ , Renderer+ , Precedence+ , Fixity(..)+ , (<?>)+ , pure+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.String ( IsString, fromString )+import Data.String.ToString ( ToString, toString )+import Data.String.Combinators ( (<>)+ , (<+>)+ , between+ , paren+ , thenParen+ , brackets+ , punctuate+ , fromShow+ , integer+ , int+ , hsep+ )+import Data.DString ( DString, fromShowS, toShowS )+import Data.Monoid ( Monoid, mempty, mappend, mconcat )+import Data.Bits ( Bits+ , (.&.)+ , (.|.)+ , xor+ , complement+ , shift+ , rotate+ , bit+ , setBit+ , clearBit+ , complementBit+ , testBit+ , bitSize+ , isSigned+ , shiftL+ , shiftR+ , rotateL+ , rotateR+ )+import Data.Fixed ( HasResolution, resolution )+import Data.Ix ( Ix, range, index, inRange, rangeSize )+import System.Random ( Random, randomR, random )+import Control.Applicative ( liftA2 )+import Control.Arrow ( first )+++--------------------------------------------------------------------------------+-- Repr+--------------------------------------------------------------------------------++{-| @Repr a@ is a value of type @a@ paired with a way to render that value to+its textual representation.++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:++@+*Repr> let r = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double+@++You can extract the value of @r@:++@+*Repr> extract r+17.281195923884734+@++And you can render @r@ to its textual representation using 'show':++@+*Repr> show r+\"fromRational (3 % 2) + fromInteger 2 + (fromInteger 3 + negate (fromInteger 4) * (fromInteger 5 - pi / sqrt (fromInteger 6)))\"+@+-}+data Repr a = Repr { extract :: a -- ^ Extract the value of the @Repr@.+ , renderer :: Renderer -- ^ Extract the renderer of the @Repr@.+ }++{-| To render you need to supply the precedence and fixity of the+enclosing context.++For more documentation about precedence and fixity see:++<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.+-}+type Renderer = Precedence -> Fixity -> DString++{-| The precedence of operators and function application.++ * Operators usually have a precedence in the range of 0 to 9.++ * Function application always has precedence 10.+-}+type Precedence = Int++-- | Precedence of function application.+funAppPrec :: Precedence+funAppPrec = 10++-- | Fixity of operators.+data Fixity = Non -- ^ No fixity information.+ | L -- ^ Left associative operator.+ | R -- ^ Right associative operator.+ deriving Eq++{-| @x \<?\> s@ annotates the rendering with the given string.++The rendering wil look like: @\"({\- s -\} ...)\"@ where @...@ is the rendering+of @x@.++This combinator is handy when you want to render the ouput of a function and you+want to see how the parameters of the function contribute to the result. For+example, suppose you defined the following function @f@:++@+f p0 p1 p2 = p0 ^ 2 + sqrt p1 * ([p2..] !! 10)+@++You can then apply @f@ to some parameters annotated with some descriptive+strings (the name of the parameter is usally a good idea):++@+f (1 \<?\> \"p0\") (2 \<?\> \"p1\") (3 \<?\> \"p2\")+@++The rendering will then look like:++@+\"({\- p0 -\} fromInteger 1) * ({\- p0 -\} fromInteger 1) + sqrt ({\- p1 -\} (fromInteger 2)) * enumFrom ({\- p2 -\} (fromInteger 3)) !! 10\"+@+-}+(<?>) :: Repr a -> DString -> Repr a+(Repr x rx) <?> s = constant x $ paren (between "{- " " -}" s <+> topLevel rx)++{-| @pure x@ constructs a 'Repr' which has @x@ as value and the showed @x@+as rendering. For example:++@+*Repr> let r = pure [1,2,3]+*Repr> extract r+[1,2,3]+*Repr> show r+\"[1,2,3]\"+@+-}+pure :: Show a => a -> Repr a+pure x = Repr x $ \prec _ -> showsPrecDS prec x+++--------------------------------------------------------------------------------+-- Instances+--------------------------------------------------------------------------------++instance Show (Repr a) where+ showsPrec prec r = toShowS $ renderer r prec Non++instance Read a => Read (Repr a) where+ readsPrec prec str =+ map (\(x, rst) -> ( constant x $+ fromString $+ take (length str - length rst)+ str+ , rst+ )+ ) $ readsPrec prec str++instance IsString a => IsString (Repr a) where+ fromString = liftA2 constant fromString fromShow++instance ToString a => ToString (Repr a) where+ toString = to toString++instance Num a => Num (Repr a) where+ fromInteger = from fromInteger "fromInteger"+ (+) = infx L 6 (+) "+"+ (-) = infx L 6 (-) "-"+ (*) = infx L 7 (*) "*"+ negate = app negate "negate"+ abs = app abs "abs"+ signum = app signum "signum"++instance Real a => Real (Repr a) where+ toRational = to toRational++instance Integral a => Integral (Repr a) where+ quot = app2 quot "quot"+ rem = app2 rem "rem"+ div = app2 div "div"+ mod = app2 mod "mod"+ quotRem = tup quotRem "quotRem"+ divMod = tup divMod "divMod"+ toInteger = to toInteger++instance Fractional a => Fractional (Repr a) where+ (/) = infx L 7 (*) "/"+ recip = app recip "recip"+ fromRational = from fromRational "fromRational"++instance Floating a => Floating (Repr a) where+ pi = constant pi "pi"+ (**) = infx R 8 (**) "**"+ logBase = app2 logBase "logBase"+ exp = app exp "exp"+ sqrt = app sqrt "sqrt"+ log = app log "log"+ sin = app sin "sin"+ tan = app tan "tan"+ cos = app cos "cos"+ asin = app asin "asin"+ atan = app atan "atan"+ acos = app acos "acos"+ sinh = app sinh "sinh"+ tanh = app tanh "tanh"+ cosh = app cosh "cosh"+ asinh = app asinh "asinh"+ atanh = app atanh "atanh"+ acosh = app acosh "acosh"++instance RealFrac a => RealFrac (Repr a) where+ properFraction (Repr x rx) =+ let (n, f) = properFraction x+ in (n, Repr f $ "snd" `apply` paren ("properFraction" <+> args [rx]))++instance RealFloat a => RealFloat (Repr a) where+ floatRadix = to floatRadix+ floatDigits = to floatDigits+ floatRange = to floatRange+ decodeFloat = to decodeFloat+ encodeFloat = from2 encodeFloat "encodeFloat"+ exponent = to exponent+ significand = app significand "significand"+ scaleFloat i = app (scaleFloat i) ("scaleFloat" <+> int i)+ isNaN = to isNaN+ isInfinite = to isInfinite+ isDenormalized = to isDenormalized+ isNegativeZero = to isNegativeZero+ isIEEE = to isIEEE+ atan2 = app2 atan2 "atan2"++instance Enum a => Enum (Repr a) where+ succ = app succ "succ"+ pred = app pred "pred"+ toEnum = from toEnum "toEnum"+ fromEnum = to fromEnum+ enumFrom (Repr x rx) = enum "From" (enumFrom x) [rx]+ enumFromThen (Repr x rx)+ (Repr y ry) = enum "FromThen" (enumFromThen x y) [rx, ry]+ enumFromTo (Repr x rx)+ (Repr y ry) = enum "FromTo" (enumFromTo x y) [rx, ry]+ enumFromThenTo (Repr x rx)+ (Repr y ry)+ (Repr z rz) = enum "FromThenTo" (enumFromThenTo x y z) [rx, ry, rz]++enum :: DString -> [a] -> [Renderer] -> [Repr a]+enum enumStr xs rxs = list xs (("enum" <> enumStr) `applies` rxs)++instance Ord a => Ord (Repr a) where+ compare = to2 compare+ (<) = to2 (<)+ (>=) = to2 (>=)+ (>) = to2 (>)+ (<=) = to2 (<=)+ max = app2 max "max"+ min = app2 min "min"++instance Eq a => Eq (Repr a) where+ (==) = to2 (==)+ (/=) = to2 (/=)++instance Bounded a => Bounded (Repr a) where+ minBound = constant minBound "minBound"+ maxBound = constant maxBound "maxBound"++instance Monoid a => Monoid (Repr a) where+ mempty = constant mempty "mempty"+ mappend = app2 mappend "mappend"+ mconcat reprs =+ let (xs, rs) = unzipReprs reprs+ in Repr (mconcat xs) ("mconcat" `apply` brackets (commas rs))++instance Bits a => Bits (Repr a) where+ (.&.) = infx L 7 (.&.) ".&."+ (.|.) = infx L 5 (.|.) ".|."+ xor = app2 xor "xor"+ complement = app complement "complement"+ shift = app2Show shift "shift"+ rotate = app2Show rotate "rotate"+ bit = from bit "bit"+ setBit = app2Show setBit "setBit"+ clearBit = app2Show clearBit "clearBit"+ complementBit = app2Show complementBit "complementBit"+ testBit x i = testBit (extract x) i+ bitSize = to bitSize+ isSigned = to isSigned+ shiftL = app2Show shiftL "shiftL"+ shiftR = app2Show shiftR "shiftR"+ rotateL = app2Show rotateL "rotateL"+ rotateR = app2Show rotateR "rotateR"++instance HasResolution a => HasResolution (Repr a) where+ resolution = to resolution++instance Ix a => Ix (Repr a) where+ range (Repr b rb, Repr e re) =+ list (range (b, e)) ("range" `apply` paren (commas [rb, re]))++ index (b, e) p = index (extract b, extract e) (extract p)+ inRange (b, e) p = inRange (extract b, extract e) (extract p)+ rangeSize (b, e) = rangeSize (extract b, extract e)++instance (Random a, Show a) => Random (Repr a) where+ randomR (b, e) = first pure . randomR (extract b, extract e)+ random = first pure . random+++--------------------------------------------------------------------------------+-- Utility functions+--------------------------------------------------------------------------------++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++from :: Show a => (a -> b) -> DString -> (a -> Repr b)+from f fStr =+ \x -> Repr (f x) $ fStr `apply` showsPrecDS funAppPrec 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+ )++to :: (a -> b) -> (Repr a -> b)+to f = f . extract++to2 :: (a -> b -> c) -> (Repr a -> Repr b -> c)+to2 f = \x y -> f (extract x) (extract y)++app :: (a -> b) -> DString -> (Repr a -> Repr b)+app f fStr =+ \(Repr x rx) -> Repr (f x) $ fStr `applies` [rx]++app2 :: (a -> b -> c) -> DString -> (Repr a -> Repr b -> Repr c)+app2 f fStr =+ \(Repr x rx) (Repr y ry) -> Repr (f x y) $ fStr `applies` [rx, ry]++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])++infx :: Fixity -> Precedence -> (a -> b -> c) -> DString+ -> (Repr a -> Repr b -> Repr c)+infx opFix opPrec op opStr =+ \(Repr x rx) (Repr y ry) ->+ Repr (x `op` y) $ bin opFix opPrec opStr rx ry++bin :: Fixity -> Precedence -> DString -> Renderer -> Renderer -> Renderer+bin opFix opPrec opStr l r =+ \prec fixity -> (prec > opPrec ||+ (prec == opPrec &&+ fixity /= Non &&+ fixity /= opFix))+ `thenParen`+ (l opPrec L <+> opStr <+> r opPrec R)++apply :: DString -> DString -> Renderer+fStr `apply` argsStr = \prec _ -> (prec >= funAppPrec)+ `thenParen`+ (fStr <+> argsStr)++applies :: DString -> [Renderer] -> Renderer+applies fStr rs = fStr `apply` args rs++args :: [Renderer] -> DString+args = hsep . map (\rx -> rx funAppPrec Non)++list :: [a] -> Renderer -> [Repr a]+list xs rXs = zipWith combine [0..] xs+ where+ combine ix x = Repr x $ bin L 9 "!!" rXs (\_ _ -> integer ix)++commas :: [Renderer] -> DString+commas = hsep . punctuate "," . map topLevel++unzipReprs :: [Repr a] -> ([a], [Renderer])+unzipReprs = foldr (\(Repr x r) ~(xs, rs) -> (x:xs, r:rs)) ([], [])++tup :: (a -> b -> (c, d)) -> DString+ -> (Repr a -> Repr b -> (Repr c, Repr d))+tup f fStr =+ \(Repr x rx) (Repr y ry) -> let (q, r) = f x y+ s = paren (fStr <+> args [rx, ry])+ in ( Repr q $ "fst" `apply` s+ , Repr r $ "snd" `apply` s+ )+++-- The End ---------------------------------------------------------------------
repr.cabal view
@@ -1,5 +1,5 @@ name: repr-version: 0.2+version: 0.3 cabal-version: >= 1.6 build-type: Simple stability: experimental@@ -10,13 +10,13 @@ license: BSD3 license-file: LICENSE category: Numeric, Text-synopsis: Render numeric expressions to their textual representation.-description: This library allows you to render a numeric expression to its+synopsis: Render overloaded expressions to their textual representation.+description: This library allows you to render overloaded expressions to their textual representation. For example: . @ *Repr> let rd = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double- *Repr> render rd+ *Repr> show rd \"fromRational (3 % 2) + fromInteger 2 + (fromInteger 3 + negate (fromInteger 4) * (fromInteger 5 - pi / sqrt (fromInteger 6)))\" @ @@ -25,9 +25,10 @@ Location: http://code.haskell.org/~basvandijk/code/repr library- build-depends: base >= 3 && < 4.2- , string-combinators >= 0.4 && < 0.5- , to-string-class >= 0.1.2 && < 0.2+ build-depends: base >= 3 && < 4.2+ , random >= 1.0 && < 1.1+ , string-combinators == 0.4.*+ , to-string-class >= 0.1.2 && < 0.2 , dstring >= 0.3.0.1 && < 0.4- exposed-modules: Repr+ exposed-modules: Text.Repr ghc-options: -Wall -O2