diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ +#! /usr/bin/env runhaskell + import Distribution.Simple main = defaultMain diff --git a/Text/Repr.hs b/Text/Repr.hs --- a/Text/Repr.hs +++ b/Text/Repr.hs @@ -3,6 +3,7 @@ , NoImplicitPrelude , OverloadedStrings , ScopedTypeVariables + , DeriveDataTypeable #-} module Text.Repr @@ -47,7 +48,7 @@ import Data.Ix ( Ix(..) ) import Foreign.Storable ( Storable(..) ) import Foreign.Ptr ( castPtr ) -import Data.Typeable ( Typeable(..)) +import Data.Typeable ( Typeable ) import Control.Applicative ( liftA2 ) import Control.Monad ( return, (>>=), fail ) import Control.Arrow ( first ) @@ -65,12 +66,9 @@ -- from random: import System.Random ( Random(..) ) --- from to-string-class: -import Data.String.ToString ( ToString(..) ) - -- from string-combinators: import Data.String.Combinators ( (<>), (<+>) - , between, paren, thenParen, brackets + , between, parens, thenParens, brackets , punctuate, fromShow, integer, int, unwords ) -- from dstring: @@ -112,6 +110,7 @@ data Repr α = Repr { extract ∷ α -- ^ Extract the value of the @Repr@. , renderer ∷ Renderer -- ^ Extract the renderer of the @Repr@. } + deriving Typeable -- | Construct a @Repr@ from the given value and its renderer. repr ∷ α → Renderer → Repr α @@ -177,7 +176,7 @@ @ -} () ∷ Repr α → DString → Repr α -(Repr x rx) s = constant x $ paren $ between "{- " " -}" s <+> topLevel rx +(Repr x rx) s = constant x $ parens $ between "{- " " -}" s <+> topLevel rx {-| @pure x@ constructs a 'Repr' which has @x@ as value and the showed @x@ as rendering. For example: @@ -190,7 +189,7 @@ \"[1,2,3]\" @ -} -pure ∷ Show α => α → Repr α +pure ∷ Show α ⇒ α → Repr α pure x = Repr x $ \prec _ → fromShowS $ showsPrec prec x @@ -201,7 +200,7 @@ instance Show (Repr α) where showsPrec prec r = toShowS $ renderer r prec Non -instance Read α => Read (Repr α) where +instance Read α ⇒ Read (Repr α) where readsPrec prec str = map (\(x, rst) → ( constant x $ fromString $ @@ -211,13 +210,10 @@ ) ) $ readsPrec prec str -instance IsString α => IsString (Repr α) where +instance IsString α ⇒ IsString (Repr α) where fromString = liftA2 constant fromString fromShow -instance ToString α => ToString (Repr α) where - toString = to toString - -instance Num α => Num (Repr α) where +instance Num α ⇒ Num (Repr α) where fromInteger n = repr (fromInteger n) $ \p _ → fromShowS $ showsPrec p n (+) = infx L 6 (+) "+" (-) = infx L 6 (-) "-" @@ -226,10 +222,10 @@ abs = app abs "abs" signum = app signum "signum" -instance Real α => Real (Repr α) where +instance Real α ⇒ Real (Repr α) where toRational = to toRational -instance Integral α => Integral (Repr α) where +instance Integral α ⇒ Integral (Repr α) where quot = app2 quot "quot" rem = app2 rem "rem" div = app2 div "div" @@ -238,12 +234,12 @@ divMod = tup divMod "divMod" toInteger = to toInteger -instance Fractional α => Fractional (Repr α) where +instance Fractional α ⇒ Fractional (Repr α) where (/) = infx L 7 (*) "/" recip = app recip "recip" fromRational = from fromRational "fromRational" -instance Floating α => Floating (Repr α) where +instance Floating α ⇒ Floating (Repr α) where pi = constant pi "pi" (**) = infx R 8 (**) "**" logBase = app2 logBase "logBase" @@ -263,12 +259,16 @@ atanh = app atanh "atanh" acosh = app acosh "acosh" -instance RealFrac α => RealFrac (Repr α) where +instance RealFrac α ⇒ RealFrac (Repr α) where properFraction (Repr x rx) = let (n, f) = properFraction x - in (n, Repr f $ "snd" `apply` paren ("properFraction" <+> args [rx])) + in (n, Repr f $ "snd" `apply` parens ("properFraction" <+> args [rx])) + truncate = to truncate + round = to round + ceiling = to ceiling + floor = to floor -instance RealFloat α => RealFloat (Repr α) where +instance RealFloat α ⇒ RealFloat (Repr α) where floatRadix = to floatRadix floatDigits = to floatDigits floatRange = to floatRange @@ -284,7 +284,7 @@ isIEEE = to isIEEE atan2 = app2 atan2 "atan2" -instance Enum α => Enum (Repr α) where +instance Enum α ⇒ Enum (Repr α) where succ = app succ "succ" pred = app pred "pred" toEnum = from toEnum "toEnum" @@ -301,7 +301,7 @@ enum ∷ DString → [α] → [Renderer] → [Repr α] enum enumStr xs rxs = list xs (("enum" <> enumStr) `applies` rxs) -instance Ord α => Ord (Repr α) where +instance Ord α ⇒ Ord (Repr α) where compare = to2 compare (<) = to2 (<) (>=) = to2 (>=) @@ -310,22 +310,22 @@ max = app2 max "max" min = app2 min "min" -instance Eq α => Eq (Repr α) where +instance Eq α ⇒ Eq (Repr α) where (==) = to2 (==) (/=) = to2 (/=) -instance Bounded α => Bounded (Repr α) where +instance Bounded α ⇒ Bounded (Repr α) where minBound = constant minBound "minBound" maxBound = constant maxBound "maxBound" -instance Monoid α => Monoid (Repr α) where +instance Monoid α ⇒ Monoid (Repr α) 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 α => Bits (Repr α) where +instance Bits α ⇒ Bits (Repr α) where (.&.) = infx L 7 (.&.) ".&." (.|.) = infx L 5 (.|.) ".|." xor = app2 xor "xor" @@ -336,7 +336,7 @@ setBit = app2Show setBit "setBit" clearBit = app2Show clearBit "clearBit" complementBit = app2Show complementBit "complementBit" - testBit x i = testBit (extract x) i + testBit = to testBit bitSize = to bitSize isSigned = to isSigned shiftL = app2Show shiftL "shiftL" @@ -345,22 +345,22 @@ rotateR = app2Show rotateR "rotateR" #if MIN_VERSION_base(4,2,0) -instance HasResolution α => HasResolution (Repr α) where +instance HasResolution α ⇒ HasResolution (Repr α) where resolution (_ ∷ p (Repr α)) = resolution (undefined ∷ p α) #else -instance HasResolution α => HasResolution (Repr α) where +instance HasResolution α ⇒ HasResolution (Repr α) where resolution = to resolution #endif -instance Ix α => Ix (Repr α) where +instance Ix α ⇒ Ix (Repr α) where range (Repr b rb, Repr e re) = - list (range (b, e)) ("range" `apply` paren (commas [rb, re])) + list (range (b, e)) ("range" `apply` parens (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 (Show α, Storable α) => Storable (Repr α) where +instance (Show α, Storable α) ⇒ Storable (Repr α) where sizeOf = to sizeOf alignment = to alignment @@ -380,24 +380,21 @@ pokeElemOff rPtr off r = pokeElemOff (castPtr rPtr) off (extract r) pokeByteOff ptr off r = pokeByteOff ptr off (extract r) -instance Typeable α => Typeable (Repr α) where - typeOf = to typeOf - #if MIN_VERSION_base(4,0,0) -instance Exception α => Exception (Repr α) where +instance Exception α ⇒ Exception (Repr α) where toException = to toException fromException se = fmap (\x → pure x ( "fromJust" - <+> paren ( "fromException" - <+> paren ( "toException" - <+> paren (showFuncArg x) + <+> parens ( "fromException" + <+> parens ( "toException" + <+> parens (showFuncArg x) ) ) ) ) $ fromException se #endif -instance (Random α, Show α) => Random (Repr α) where +instance (Random α, Show α) ⇒ Random (Repr α) where randomR (b, e) = first pure ∘ randomR (extract b, extract e) random = first pure ∘ random @@ -412,14 +409,14 @@ constant ∷ α → DString → Repr α constant x xStr = repr x $ \_ _ → xStr -showFuncArg ∷ Show α => α → DString +showFuncArg ∷ Show α ⇒ α → DString showFuncArg = fromShowS ∘ showsPrec funAppPrec -from ∷ Show α => (α → β) → DString → (α → Repr β) +from ∷ Show α ⇒ (α → β) → DString → (α → Repr β) from f fStr = \x → repr (f x) $ fStr `apply` showFuncArg x -from2 ∷ (Show α, Show β) => (α → β → γ) → DString → (α → β → Repr γ) +from2 ∷ (Show α, Show β) ⇒ (α → β → γ) → DString → (α → β → Repr γ) from2 f fStr = \x y → repr (f x y) $ fStr `apply`(showFuncArg x <+> showFuncArg y) @@ -437,7 +434,7 @@ app2 f fStr = \(Repr x rx) (Repr y ry) → repr (f x y) $ fStr `applies` [rx, ry] -app2Show ∷ Show β => (α → β → α) → DString → (Repr α → β → Repr α) +app2Show ∷ Show β ⇒ (α → β → α) → DString → (Repr α → β → Repr α) app2Show f fStr = \(Repr x rx) y → repr (f x y) @@ -455,12 +452,12 @@ (prec == opPrec ∧ fixity /= Non ∧ fixity /= opFix)) - `thenParen` + `thenParens` (l opPrec L <+> opStr <+> r opPrec R) apply ∷ DString → DString → Renderer fStr `apply` argsStr = \prec _ → (prec >= funAppPrec) - `thenParen` + `thenParens` (fStr <+> argsStr) applies ∷ DString → [Renderer] → Renderer @@ -484,7 +481,7 @@ → (Repr α → Repr β → (Repr γ, Repr δ)) tup f fStr = \(Repr x rx) (Repr y ry) → let (q, r) = f x y - s = paren (fStr <+> args [rx, ry]) + s = parens (fStr <+> args [rx, ry]) in ( repr q $ "fst" `apply` s , repr r $ "snd" `apply` s ) diff --git a/repr.cabal b/repr.cabal --- a/repr.cabal +++ b/repr.cabal @@ -1,5 +1,5 @@ name: repr -version: 0.3.2.1 +version: 0.4 cabal-version: >= 1.6 build-type: Simple stability: experimental @@ -25,11 +25,10 @@ Location: http://code.haskell.org/~basvandijk/code/repr library - build-depends: base >= 3 && < 4.3 + build-depends: base >= 3 && < 4.4 , base-unicode-symbols >= 0.1.1 && < 0.3 , random >= 1.0 && < 1.1 - , string-combinators >= 0.5 && < 0.6 - , to-string-class >= 0.1.2 && < 0.2 - , dstring >= 0.3.0.1 && < 0.4 + , string-combinators >= 0.6 && < 0.7 + , dstring >= 0.3.0.1 && < 0.5 exposed-modules: Text.Repr ghc-options: -Wall