diff --git a/Repr.hs b/Repr.hs --- a/Repr.hs +++ b/Repr.hs @@ -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: --- --- --- --- 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: + + + +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 --------------------------------------------------------------------- diff --git a/repr.cabal b/repr.cabal --- a/repr.cabal +++ b/repr.cabal @@ -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