repr (empty) → 0.1
raw patch · 4 files changed
+373/−0 lines, 4 filesdep +basedep +dstringdep +string-combinatorssetup-changed
Dependencies added: base, dstring, string-combinators, to-string-class
Files
- LICENSE +31/−0
- Repr.hs +307/−0
- Setup.hs +2/−0
- repr.cabal +33/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2009 Bas van Dijk++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.++ * The name of Bas van Dijk and the names of contributors may NOT+ 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.
+ Repr.hs view
@@ -0,0 +1,307 @@+{-# 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 rd = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double+-- @+--+-- You can extract the value of @rd@:+--+-- @+-- *Repr> value rd+-- 17.281195923884734+-- @+--+-- And you can than render @rd@ to its textual representation:+--+-- @+-- *Repr> render rd+-- \"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 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++-- | 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 output 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 $ \prec fixity -> paren (between "{- " " -}" s <+> rx prec fixity)+++--------------------------------------------------------------------------------+-- 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 $ \prec fixity -> (prec > 9 || (prec == 9 && fixity /= Non && fixity /= L))+ `thenParen`+ ("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 'Repr' from a given value and string.+constant :: a -> DString -> Repr a+constant x xStr = S x $ \_ _ -> xStr++-- | Precedence of function application.+funAppPrec :: Precedence+funAppPrec = 10++from :: Show a => (a -> b) -> DString -> (a -> Repr b)+from f fStr = \x -> S (f x) $+ \prec _ -> (prec >= funAppPrec)+ `thenParen`+ (fStr <+> fromShowS (showsPrec funAppPrec x))++from2 :: (Show a, Show b) => (a -> b -> c) -> DString -> (a -> b -> Repr c)+from2 f fStr = \x y -> S (f x y) $+ \prec _ -> (prec >= funAppPrec)+ `thenParen`+ (fStr <+> fromShowS (showsPrec funAppPrec x)+ <+> fromShowS (showsPrec funAppPrec y))++to :: (a -> b) -> Repr a -> b+to f = f . value++to2 :: (a -> b -> c) -> Repr a -> Repr b -> c+to2 f x y = f (value x) (value y)++app :: (a -> b) -> DString -> (Repr a -> Repr b)+app fun funStr =+ \(S x rx) -> S (fun x) $ funStr `apply` args [rx]++app2 :: (a -> b -> c) -> DString -> (Repr a -> Repr b -> Repr c)+app2 fun funStr =+ \(S x rx) (S y ry) -> S (fun x y) $ funStr `apply` args [rx, ry]++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) $+ \prec fixity -> (prec > opPrec ||+ (prec == opPrec &&+ fixity /= Non &&+ fixity /= opFix))+ `thenParen`+ (rx opPrec L <+> opStr <+> ry opPrec R)++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+ )++args :: [Renderer] -> DString+args = hsep . map (\rx -> rx funAppPrec Non)++apply :: DString -> DString -> Renderer+funStr `apply` argsStr = \prec _ -> (prec >= funAppPrec)+ `thenParen`+ (funStr <+> argsStr)+++-- The End ---------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ repr.cabal view
@@ -0,0 +1,33 @@+name: repr+version: 0.1+cabal-version: >= 1.6+build-type: Simple+stability: experimental+tested-with: GHC ==6.10.4+author: Bas van Dijk+maintainer: v.dijk.bas@gmail.com+copyright: (c) 2009 Bas van Dijk+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+ textual representation. For example:+ .+ @+ *Repr> let rd = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double+ *Repr> render rd+ \"fromRational (3 % 2) + fromInteger 2 + (fromInteger 3 + negate (fromInteger 4) * (fromInteger 5 - pi / sqrt (fromInteger 6)))\"+ @++source-repository head+ Type: darcs+ 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 && < 0.2+ , dstring >= 0.3 && < 0.4+ exposed-modules: Repr+ ghc-options: -Wall -O2