repr 0.1 → 0.2
raw patch · 2 files changed
+191/−124 lines, 2 filesdep ~dstringdep ~to-string-class
Dependency ranges changed: dstring, to-string-class
Files
- Repr.hs +186/−119
- repr.cabal +5/−5
Repr.hs view
@@ -36,94 +36,109 @@ -- 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)))\"--- @+{-| @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 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.+{-| 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.+{-| 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 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\"--- @+{-| @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 $ \prec fixity -> paren (between "{- " " -}" s <+> rx prec fixity)+(S x rx) <?> s =+ S x $ \_ _ -> paren (between "{- " " -}" s <+> rx 0 Non) --------------------------------------------------------------------------------@@ -155,9 +170,9 @@ toInteger = to toInteger instance Fractional a => Fractional (Repr a) where- (/) = infx L 7 (*) "/"- recip = app recip "recip"- fromRational = from fromRational "fromRational"+ (/) = infx L 7 (*) "/"+ recip = app recip "recip"+ fromRational = from fromRational "fromRational" instance Floating a => Floating (Repr a) where pi = constant pi "pi"@@ -205,17 +220,19 @@ 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]+ 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)+ combine i y = S y $ bin L 9 "!!" ("enum" <> enumStr <+> args rxs) (integer i) instance Ord a => Ord (Repr a) where compare = to2 compare@@ -238,70 +255,120 @@ -- Utility functions -------------------------------------------------------------------------------- --- | Construct 'Repr' from a given value and string.+-- | Construct a '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+{-| 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) $- \prec _ -> (prec >= funAppPrec)- `thenParen`- (fStr <+> fromShowS (showsPrec funAppPrec x))+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) $- \prec _ -> (prec >= funAppPrec)- `thenParen`- (fStr <+> fromShowS (showsPrec funAppPrec x)- <+> fromShowS (showsPrec funAppPrec y))+from2 f fStr =+ \x y -> S (f x y) $ fStr `apply`( fromShowS (showsPrec funAppPrec x)+ <+> fromShowS (showsPrec funAppPrec y)+ ) -to :: (a -> b) -> Repr a -> b+-- | Return the converted value of the 'Repr'.+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)+-- | 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 fun funStr =- \(S x rx) -> S (fun x) $ funStr `apply` args [rx]+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 fun funStr =- \(S x rx) (S y ry) -> S (fun x y) $ funStr `apply` args [rx, ry]+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) $- \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- )+ S (x `op` y) $ bin opFix opPrec opStr (rx opPrec L) (ry opPrec R) -args :: [Renderer] -> DString-args = hsep . map (\rx -> rx funAppPrec Non)+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 ---------------------------------------------------------------------
repr.cabal view
@@ -1,5 +1,5 @@ name: repr-version: 0.1+version: 0.2 cabal-version: >= 1.6 build-type: Simple stability: experimental@@ -25,9 +25,9 @@ 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+ build-depends: base >= 3 && < 4.2+ , string-combinators >= 0.4 && < 0.5+ , to-string-class >= 0.1.2 && < 0.2+ , dstring >= 0.3.0.1 && < 0.4 exposed-modules: Repr ghc-options: -Wall -O2