repr 0.4 → 0.4.1

raw patch · 4 files changed

+267/−135 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Prelude/Repr.hs +80/−0
• Text/Repr.hs +179/−128
• repr.cabal +7/−6

@@ -1,4 +1,4 @@-Copyright (c) 2009-2010 Bas van Dijk+Copyright (c) 2009-2011 Bas van Dijk  All rights reserved. 

@@ -0,0 +1,80 @@+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, OverloadedStrings #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Prelude.Repr+-- Copyright   :  (c) 2009–2011 Bas van Dijk+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>+--+-- The numeric functions from the 'Prelude' lifted into @'Repr's@. +--+--------------------------------------------------------------------------------++module Prelude.Repr where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import qualified Prelude ( subtract+                         , even+                         , odd+                         , gcd+                         , lcm+                         , (^)+                         , (^^) +                         , fromIntegral+                         , realToFrac+                         )++import Prelude   ( Num, Integral, Fractional, Real )+import Data.Bool ( Bool )++-- from repr:+import Text.Repr ( Repr, Fixity(R), to, app, app2, infx )+++--------------------------------------------------------------------------------+-- Numeric functions+--------------------------------------------------------------------------------++-- | Lifts @Prelude.'Prelude.subtract'@ into @'Repr's@+subtract ∷ Num α ⇒ Repr α → Repr α → Repr α+subtract = app2 Prelude.subtract "subtract"++-- | Lifts @Prelude.'Prelude.even'@ into a 'Repr'+even ∷ Integral α ⇒ Repr α → Bool+even = to Prelude.even++-- | Lifts @Prelude.'Prelude.odd'@ into a 'Repr'+odd ∷ Integral α ⇒ Repr α → Bool+odd = to Prelude.odd++-- | Lifts @Prelude.'Prelude.gcd'@ into @'Repr's@+gcd ∷ Integral α ⇒ Repr α → Repr α → Repr α+gcd = app2 Prelude.gcd "gcd"++-- | Lifts @Prelude.'Prelude.lcm'@ into @'Repr's@+lcm ∷ Integral α ⇒ Repr α → Repr α → Repr α+lcm = app2 Prelude.lcm "lcm"++-- | Lifts @Prelude.'Prelude.^'@ into @'Repr's@+(^) ∷ (Num α, Integral β) ⇒ Repr α → Repr β → Repr α+(^) = infx R 8 (Prelude.^) "^"++-- | Lifts @Prelude.'Prelude.^^'@ into @'Repr's@+(^^) ∷ (Fractional α, Integral β) ⇒ Repr α → Repr β → Repr α+(^^) = infx R 8 (Prelude.^^) "^^"++-- | Lifts @Prelude.'Prelude.fromIntegral'@ into @'Repr's@+fromIntegral ∷ (Integral α, Num β) ⇒ Repr α → Repr β+fromIntegral = app Prelude.fromIntegral "fromIntegral"++-- | Lifts @Prelude.'Prelude.realToFrac'@ into @'Repr's@+realToFrac ∷ (Real α, Fractional β) ⇒ Repr α → Repr β+realToFrac = app Prelude.realToFrac "realToFrac"+++-- The End ---------------------------------------------------------------------

@@ -6,9 +6,19 @@            , DeriveDataTypeable   #-} +--------------------------------------------------------------------------------+-- |+-- Module      :  Text.Repr+-- Copyright   :  (c) 2009–2011 Bas van Dijk+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>+--+-- Textual representation of values.+--+--------------------------------------------------------------------------------+ module Text.Repr     ( Repr-    , repr     , extract     , renderer     , Renderer@@ -16,6 +26,14 @@     , Fixity(..)     , (<?>)     , pure+    , repr++      -- * Utilities+      -- | Handy utilities when writing type class instances for @Reprs@.+    , constant+    , to,  to2+    , app, app2+    , infx     ) where  @@ -43,15 +61,15 @@ import Data.Function           ( ($) ) import Data.Functor            ( fmap ) import Data.Fixed              ( HasResolution(..) )-import Data.List               ( foldr, map, zipWith, take, length )+import Data.List               ( map, zipWith, take, length, unzip ) import Data.Int                ( Int ) import Data.Ix                 ( Ix(..) ) import Foreign.Storable        ( Storable(..) ) import Foreign.Ptr             ( castPtr ) import Data.Typeable           ( Typeable ) import Control.Applicative     ( liftA2 )-import Control.Monad           ( return, (>>=), fail )-import Control.Arrow           ( first )+import Control.Monad           ( return )+import Control.Arrow           ( first, (&&&) ) import Text.Show               ( Show(..) ) import Text.Read               ( Read(..) ) @@ -59,6 +77,10 @@ import Control.Exception       ( Exception(..) ) #endif +#if __GLASGOW_HASKELL__ < 700+import Control.Monad           ( (>>=), fail )+#endif+ -- from base-unicode-symbols: import Data.Function.Unicode   ( (∘) ) import Data.Bool.Unicode       ( (∧), (∨) )@@ -93,7 +115,7 @@ *Repr> let r = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double @ -You can extract the value of @r@:+You can 'extract' the value of @r@:  @ *Repr> extract r@@ -104,7 +126,7 @@  @ *Repr> show r-\"fromRational (3 % 2) + 2 + (3 + negate 4 * (5 - pi / sqrt 6))\"+\"1.5 + 2.0 + (3.0 + negate 4.0 * (5.0 - pi / sqrt 6.0))\" @ -} data Repr α = Repr { extract  ∷ α        -- ^ Extract the value of the @Repr@.@@ -112,10 +134,6 @@                    }             deriving Typeable --- | Construct a @Repr@ from the given value and its renderer.-repr ∷ α → Renderer → Repr α-repr = Repr- {-| To render you need to supply the precedence and fixity of the enclosing context. @@ -176,7 +194,7 @@ @ -} (<?>) ∷ Repr α → DString → Repr α-(Repr x rx) <?> s = constant x $ parens $ between "{- " " -}" s <+> topLevel rx+(Repr x rx) <?> s = constant x $ parens $ between "{- " " -}" s <+> runRenderer rx  {-| @pure x@ constructs a 'Repr' which has @x@ as value and the showed @x@ as rendering. For example:@@ -190,10 +208,31 @@ @ -} pure ∷ Show α ⇒ α → Repr α-pure x = Repr x $ \prec _ → fromShowS $ showsPrec prec x+pure x = repr x $ \prec _ → fromShowS $ showsPrec prec x +-- | Construct a @Repr@ from the given value and its renderer.+repr ∷ α → Renderer → Repr α+repr = Repr + --------------------------------------------------------------------------------+-- Handy CPP macro's+--------------------------------------------------------------------------------++#define PURE(N)      N  = pure  ∘  (N)+#define TO(N)        N  = to       (N)+#define TO2(N)      (N) = to2      (N)+#define FROM(N)      N  = from     (N) "N"+#define FROM2(N)     N  = from2    (N) "N"+#define INFX(F,P,N) (N) = infx F P (N) "N"+#define APP(N)       N  = app      (N) "N"+#define APP2(N)      N  = app2     (N) "N"+#define APP2SHOW(N)  N  = app2Show (N) "N"+#define TUP(N)       N  = tup      (N) "N"+#define CONSTANT(N)  N  = constant (N) "N"+++-------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- @@ -214,81 +253,84 @@     fromString = liftA2 constant fromString fromShow  instance Num α ⇒ Num (Repr α) where-    fromInteger n = repr (fromInteger n) $ \p _ → fromShowS $ showsPrec p n-    (+)           = infx L 6 (+)         "+"-    (-)           = infx L 6 (-)         "-"-    (*)           = infx L 7 (*)         "*"-    negate        = app      negate      "negate"-    abs           = app      abs         "abs"-    signum        = app      signum      "signum"+    PURE(fromInteger)+    INFX(L, 6, +)+    INFX(L, 6, -)+    INFX(L, 7, *)+    APP(negate)+    APP(abs)+    APP(signum)  instance Real α ⇒ Real (Repr α) where-    toRational = to toRational+    TO(toRational)  instance Integral α ⇒ Integral (Repr α) 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+    APP2(quot)+    APP2(rem)+    APP2(div)+    APP2(mod)+    TUP(quotRem)+    TUP(divMod)+    TO(toInteger)  instance Fractional α ⇒ Fractional (Repr α) where-    (/)          = infx L 7 (*)          "/"-    recip        = app      recip        "recip"-    fromRational = from     fromRational "fromRational"+    INFX(L, 7, /)+    APP(recip)+    PURE(fromRational)  instance Floating α ⇒ Floating (Repr α) 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"+    CONSTANT(pi)+    INFX(R, 8, **)+    APP2(logBase)+    APP(exp)+    APP(sqrt)+    APP(log)+    APP(sin)+    APP(tan)+    APP(cos)+    APP(asin)+    APP(atan)+    APP(acos)+    APP(sinh)+    APP(tanh)+    APP(cosh)+    APP(asinh)+    APP(atanh)+    APP(acosh)  instance RealFrac α ⇒ RealFrac (Repr α) where+    TO(truncate)+    TO(round)+    TO(ceiling)+    TO(floor)+     properFraction (Repr x rx) =         let (n, f) = properFraction x-        in (n, Repr f $ "snd" `apply` parens ("properFraction" <+> args [rx]))-    truncate = to truncate-    round    = to round-    ceiling  = to ceiling-    floor    = to floor+        in (n, repr f $ "snd" `apply` parens ("properFraction" <+> args [rx]))  instance RealFloat α ⇒ RealFloat (Repr α) 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"+    TO(floatRadix)+    TO(floatDigits)+    TO(floatRange)+    TO(decodeFloat)+    TO(isNaN)+    TO(isInfinite)+    TO(isDenormalized)+    TO(isNegativeZero)+    TO(isIEEE)+    TO(exponent)+    APP(significand)+    APP2(atan2)+    FROM2(encodeFloat) +    scaleFloat i = app (scaleFloat i) ("scaleFloat" <+> int i)+ instance Enum α ⇒ Enum (Repr α) where-    succ     = app   succ   "succ"-    pred     = app   pred   "pred"-    toEnum   = from  toEnum "toEnum"-    fromEnum = to    fromEnum+    APP(succ)+    APP(pred)+    FROM(toEnum)+    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]@@ -302,54 +344,58 @@ enum enumStr xs rxs = list xs (("enum" <> enumStr) `applies` rxs)  instance Ord α ⇒ Ord (Repr α) where-    compare = to2  compare-    (<)     = to2  (<)-    (>=)    = to2  (>=)-    (>)     = to2  (>)-    (<=)    = to2  (<=)-    max     = app2 max "max"-    min     = app2 min "min"+    compare = to2 compare+    TO2(<)+    TO2(>=)+    TO2(>)+    TO2(<=)+    APP2(max)+    APP2(min)  instance Eq α ⇒ Eq (Repr α) where-    (==) = to2 (==)-    (/=) = to2 (/=)+    TO2(==)+    TO2(/=)  instance Bounded α ⇒ Bounded (Repr α) where-    minBound = constant minBound "minBound"-    maxBound = constant maxBound "maxBound"+    CONSTANT(minBound)+    CONSTANT(maxBound)  instance Monoid α ⇒ Monoid (Repr α) where-    mempty  = constant mempty  "mempty"-    mappend = app2     mappend "mappend"+    CONSTANT(mempty)+    APP2(mappend)+     mconcat reprs =         let (xs, rs) = unzipReprs reprs         in Repr (mconcat xs) ("mconcat" `apply` brackets (commas rs)) +unzipReprs ∷ [Repr α] → ([α], [Renderer])+unzipReprs = unzip ∘ map (extract &&& renderer)+ instance Bits α ⇒ Bits (Repr α) 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       = to       testBit-    bitSize       = to       bitSize-    isSigned      = to       isSigned-    shiftL        = app2Show shiftL        "shiftL"-    shiftR        = app2Show shiftR        "shiftR"-    rotateL       = app2Show rotateL       "rotateL"-    rotateR       = app2Show rotateR       "rotateR"+    INFX(L, 7, .&.)+    INFX(L, 5, .|.)+    APP2(xor)+    APP(complement)+    APP2SHOW(shift)+    APP2SHOW(rotate)+    FROM(bit)+    APP2SHOW(setBit)+    APP2SHOW(clearBit)+    APP2SHOW(complementBit)+    TO(testBit)+    TO(bitSize)+    TO(isSigned)+    APP2SHOW(shiftL)+    APP2SHOW(shiftR)+    APP2SHOW(rotateL)+    APP2SHOW(rotateR)  #if MIN_VERSION_base(4,2,0) instance HasResolution α ⇒ HasResolution (Repr α) where     resolution (_ ∷ p (Repr α)) = resolution (undefined ∷ p α) #else instance HasResolution α ⇒ HasResolution (Repr α) where-    resolution = to resolution+    TO(resolution) #endif  instance Ix α ⇒ Ix (Repr α) where@@ -361,8 +407,8 @@     rangeSize (b, e)   = rangeSize (extract b, extract e)  instance (Show α, Storable α) ⇒ Storable (Repr α) where-    sizeOf    = to sizeOf-    alignment = to alignment+    TO(sizeOf)+    TO(alignment)      peekElemOff rPtr off = do       x ← peekElemOff (castPtr rPtr) off@@ -382,7 +428,7 @@  #if MIN_VERSION_base(4,0,0) instance Exception α ⇒ Exception (Repr α) where-    toException = to toException+    TO(toException)     fromException se =         fmap (\x → pure x <?> ( "fromJust"                               <+> parens ( "fromException"@@ -403,9 +449,18 @@ -- Utility functions -------------------------------------------------------------------------------- -topLevel ∷ Renderer → DString-topLevel r = r 0 Non+mapRepr ∷ (α → β) → (Renderer → Renderer)+        → (Repr α → Repr β)+mapRepr f g = \(Repr x rx) → repr (f x) (g rx) +mapRepr2 ∷ (α → β → γ) → (Renderer → Renderer → Renderer)+         → (Repr α → Repr β → Repr γ)+mapRepr2 f g = \(Repr x rx) (Repr y ry) → repr (f x y) (g rx ry)++runRenderer ∷ Renderer → DString+runRenderer r = r 0 Non++-- | For example: @pi = 'constant' 'pi' \"pi\"@ constant ∷ α → DString → Repr α constant x xStr = repr x $ \_ _ → xStr @@ -413,26 +468,26 @@ showFuncArg = fromShowS ∘ showsPrec funAppPrec  from ∷ Show α ⇒ (α → β) → DString → (α → Repr β)-from f fStr =-    \x → repr (f x) $ fStr `apply` showFuncArg x+from f fStr = \x → repr (f x) $ fStr `apply` showFuncArg x  from2 ∷ (Show α, Show β) ⇒ (α → β → γ) → DString → (α → β → Repr γ)-from2 f fStr =-    \x y → repr (f x y) $ fStr `apply`(showFuncArg x <+> showFuncArg y)+from2 f fStr = \x y → repr (f x y) $ fStr `apply`(showFuncArg x <+> showFuncArg y) +-- | For example: @toInteger = 'to' 'toInteger'@ to ∷ (α → β) → (Repr α → β) to f = f ∘ extract +-- | For example: @(<) = 'to2' ('<')@ to2 ∷ (α → β → γ) → (Repr α → Repr β → γ) to2 f = \x y → f (extract x) (extract y) +-- | For example:  @abs = 'app' 'abs' \"abs\"@ app ∷ (α → β) → DString → (Repr α → Repr β)-app f fStr =-    \(Repr x rx) → repr (f x) $ fStr `applies` [rx]+app f fStr = mapRepr f (\rx → fStr `applies` [rx]) +-- | For example: @div = 'app2' 'div' \"div\"@ app2 ∷ (α → β → γ) → DString → (Repr α → Repr β → Repr γ)-app2 f fStr =-    \(Repr x rx) (Repr y ry) → repr (f x y) $ fStr `applies` [rx, ry]+app2 f fStr = mapRepr2 f (\rx ry → fStr `applies` [rx, ry])  app2Show ∷ Show β ⇒ (α → β → α) → DString → (Repr α → β → Repr α) app2Show f fStr =@@ -440,11 +495,10 @@         repr (f x y)              (fStr `applies` [rx, \prec _ → fromShowS $ showsPrec prec y]) +-- | For example: @(+) = 'infx' 'L' 6 ('+') \"+\"@ infx ∷ Fixity → Precedence → (α → β → γ) → DString      → (Repr α → Repr β → Repr γ)-infx opFix opPrec op opStr =-    \(Repr x rx) (Repr y ry) →-        repr (x `op` y) $ bin opFix opPrec opStr rx ry+infx opFix opPrec op opStr = mapRepr2 op (bin opFix opPrec opStr)  bin ∷ Fixity → Precedence → DString → Renderer → Renderer → Renderer bin opFix opPrec opStr l r =@@ -472,19 +526,16 @@       combine ix x = repr x $ bin L 9 "!!" rXs (\_ _ → integer ix)  commas ∷ [Renderer] → DString-commas = unwords ∘ punctuate "," ∘ map topLevel--unzipReprs ∷ [Repr α] → ([α], [Renderer])-unzipReprs = foldr (\(Repr x r) ~(xs, rs) → (x:xs, r:rs)) ([], [])+commas = unwords ∘ punctuate "," ∘ map runRenderer  tup ∷ (α → β → (γ, δ)) → DString     → (Repr α → Repr β → (Repr γ, Repr δ))-tup f fStr =-    \(Repr x rx) (Repr y ry) → let (q, r) = f x y-                                   s = parens (fStr <+> args [rx, ry])-                               in ( repr q $ "fst" `apply` s-                                  , repr r $ "snd" `apply` s-                                  )+tup f fStr = \(Repr x rx) (Repr y ry) →+             let (q, r) = f x y+                 s = parens (fStr <+> args [rx, ry])+             in ( repr q $ "fst" `apply` s+                , repr r $ "snd" `apply` s+                )   -- The End ---------------------------------------------------------------------

@@ -1,12 +1,11 @@ name:          repr-version:       0.4+version:       0.4.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-2010 Bas van Dijk+copyright:     (c) 2009-2011 Bas van Dijk license:       BSD3 license-file:  LICENSE category:      Numeric, Text@@ -15,9 +14,11 @@                textual representation. For example:                .                @-               *Repr> let rd = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double+               *Repr> let r = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double+               *Repr> extract r+               17.281195923884734                *Repr> show rd-               \"fromRational (3 % 2) + 2 + (3 + negate 4 * (5 - pi / sqrt 6))\"+               \"1.5 + 2.0 + (3.0 + negate 4.0 * (5.0 - pi / sqrt 6.0))\"                @  source-repository head@@ -30,5 +31,5 @@                , random               >= 1.0     && < 1.1                , string-combinators   >= 0.6     && < 0.7                , dstring              >= 0.3.0.1 && < 0.5-  exposed-modules: Text.Repr+  exposed-modules: Text.Repr, Prelude.Repr   ghc-options: -Wall