Wednesday, May 2, 2012

Printing types

The following exercise consists in write a function that prints the type of a given monomorphic function. No, we are not talking about type-inference. We will use the one that Haskell brings. Anyway, the task is to define a function writeType that, given some Haskell value (which can be a function), print its type on the screen.

It's not a hard exercise, so it can be tried by a beginner that already knows how to work with Haskell types. Try it before read the solution.

This is also my first attempt to create a blog post with Pancod and HsColour from a literate Haskell source code.

Solution

The approach of the solution is similar (identical) to the one taken in the Data.Typeable base module. We will import the intersperse function, which will be useful when defining a pretty-printer for types.

import Data.List (intersperse)

Our first mission is a function that, for some type a, returns its type signature. Something like typeOf :: a -> Type. But we need to first define the Type datatype.

data Type =
   TCons String [Type]
 | TList Type
 | TTuple [Type]
 | TFun Type Type
   deriving Show
  • The TCons constructor is for type constructors, like Int, Maybe, IO or Map.
  • The TList for lists of a given type.
  • The TTuple for tuples. With the empty list you get the unit type (()).
  • Finally, TFun is the type constructor for functions.

Note that one can, actually, make all types only with the TCons constructor (think how if you don't know it), but I still prefer this way.

Since we want of typeOf to run over every type, a good way to achieve this is to use a typeclass and implement specific methods for each type.

class Typed a where
 typeOf :: a -> Type

Now is trivial to make some instances.

instance Typed Int where
 typeOf _ = TCons "Int" []

instance Typed Float where
 typeOf _ = TCons "Float" []

instance Typed Bool where
 typeOf _ = TCons "Bool" []

instance Typed Char where
 typeOf _ = TCons "Char" []

And that's the way for types of null arity. Note that we always discard arguments. This is necessary, because we really need to avoid depending in values. We will have problems if the compiler tries to reduce some expression. Even it would be nonsensical, because the type of a value has nothing to do with one of its values.

Now, let's define our first type trick. If we want to define instances for types with positive arity, we will need to apply typeOf with argument(s) of the inner(s) type(s).

Here is provided the deconstructor for types with arity one.

decons :: t a -> a
decons = undefined

As you can see, it is not actually defined. All we need is to use its type, so the definition does not matter. Note why we did not want of typeOf to try to evaluate its argument.

Let's apply this to the Maybe type.

instance Typed a => Typed (Maybe a) where
 typeOf m = let t = typeOf $ decons m
            in  TCons "Maybe" [t]

The same trick works with lists.

instance Typed a => Typed [a] where
 typeOf xs = let t = typeOf $ decons xs
             in  TList t

It's the turn for tuples. We will do only the 2-uple, since for other tuple orders the same idea is valid. Since the constructor of 2-uples has arity two, we need another deconstructor.

decons2 :: t a b -> (a,b)
decons2 = undefined

I'm sure you already figure out how to define the deconsN function for any N. Using the deconstructor with tuples we have the following instance.

instance (Typed a,Typed b) => Typed (a,b) where
 typeOf tup = let (x,y) = decons2 tup
              in  TTuple [typeOf x,typeOf y]

The good thing is that all types are traversed recursively. For example, with typeOf (1,Just 2), it's reduced to TTuple [typeOf 1,typeOf (Just 2)], then to TTuple [TCons "Int" [], TCons "Maybe" [typeOf 2]], and finally to TTuple [TCons "Int" [], TCons "Maybe" [TCons "Int" []]]. Well, this evaluation is not true, but it works like that (replacing with undefineds everywhere!). What does this work is the Haskell type system. We are only playing with types, never with values.

The last instance we will do is for the function type constructor. Though, if you think about it, there is not something new. The arrow -> is just a type constructor with arity 2.

instance (Typed a,Typed b) => Typed (a -> b) where
 typeOf f = let (x,y) = decons2 f
            in  TFun (typeOf x) (typeOf y)

However, our problem does not end here (though here ends the most interesting part). The problem was to print the type of a given function. The next step is to write a pretty-printer function for types.

First, it will be handy to have a function that tell us if a type will need to be parenthesized when appears as an argument for some type constructor. For example, Int -> Int in Maybe (Int -> Int).

plural :: Type -> Bool
plural (TCons _ xs) = not $ null xs
plural (TFun _ _) = True
plural _ = False

An argument of an applied type constructor only will need to be parenthesized when its arity is not null. A function always will need it (because it's a constructor with arity two). No other will thanks to the syntax of tuples and list types. They are already parenthesized in some way.

However if the type constructor is the arrow -> the parenthesis are only needed when the left argument is a function type, since is infix and right-associative. For example, Maybe Float -> (Float -> Float) does not need parenthesis (I put them to make clear the association order), but (Maybe Float -> Float) -> Float needs them. Let's define then a function that test if a type is functional.

isFun :: Type -> Bool
isFun (TFun _ _) = True
isFun _ = False

To surround an expression with parenthesis we define the par function.

par :: String -> String
par str = concat ["(",str,")"]

It's time for our printType :: Type -> String function. For expressions that must be parenthesized when needed we will use the variant printTypeIf. It will put parenthesis when a test function holds.

printTypeIf :: (Type -> Bool) -> Type -> String
printTypeIf f t = (if f t then par else id) $ printType t

Now the full pretty-printer, using all the mentioned above.

printType :: Type -> String
printType (TCons n ts) = unwords $ n : fmap (printTypeIf plural) ts
printType (TList t) = concat [ "[" , printType t , "]" ]
printType (TTuple ts) = par . concat $ intersperse ", " $ fmap printType ts
printType (TFun t1 t2) = unwords [ printTypeIf isFun t1 , "->" , printType t2 ]

Finally, the required function writeType :: Typed a => a -> IO () can be written now immediately.

writeType :: Typed a => a -> IO ()
writeType = putStrLn . printType . typeOf

So we are done! You can try the next example:

example :: (Int -> Int) -> Maybe Bool -> Maybe (Int -> Int)
example f mb = fmap (\b -> if b then const 0 else f) mb

And that's all!

Closure

I think this is a very funny exercise, and that's why I posted it here. I hope you enjoy it like I did. You can get the code of this post from GitHub.

Good luck, Daniel Díaz.

Monday, April 30, 2012

HaTeX 3.3: Release notes

I was really really wishing this release! I put a lot of efforts on it and now I feel pretty good! All right, let's see quickly what's new. A list of changes is contained in the package source distribution, in the ReleaseNotes file.

Class system

Where are all those .Monad modules? They are missing!

Yes, yes. There is not .Monad modules now! Instead, there is a new class: LaTeXC. Both LaTeX and LaTeXT are instances of it, so a single module can contain both interfaces. More details in a previous post.

Trees

I have a tree in Haskell and I want to print it nicely. What can I do?

Now you can use HaTeX! How? Simple. Use directly the tree type defined in HaTeX or transform the one you have to it, choose a function to render the nodes and, finally, use the tree function to obtain the LaTeX code that prints the tree.

The HaTeX User's Guide

Finally I wrote a guide for HaTeX! At least, a stub of the guide.  And I made it open source! So you can contribute also to the guide!

I will change it, extend it and improve it all the time. A ready-to-read PDF version is also available.

Till the next time

I am going to continue working improving the library and the guide. I think HaTeX has reached a point of more stability. Good news, I guess. Now, I hope you enjoy these changes. I will write here any news.

Good luck,
Daniel Díaz.

Saturday, April 28, 2012

HaTeX 3.3: HaTeX with class

So I finally decided to merge the normal (what sometimes I called applicative) interface with the monadic one. It was not easy to me, but I feel like doing the right thing. I thought: "If I would release this library for the first time, how you would like it to be?" The answer then was "merge both interfaces!".

As a consequence of this decision, I have to admit that my work as maintainer has been reduced considerably. Now HaTeX-meta is deprecated, until HaTeX needs a similar tool, and I have about the half of modules to maintain.

Although the version has been bumped to 3.3 (being a major revision), everything code that worked until today must to work now. The only change you may need to do is to drop de .Monad in the import list. If you have some issue, please, make me know it.

I hope all you feel happy with this.

About the implementation

All I did is to define the following class:

class (Monoid l,IsString l) => LaTeXC l where
 liftListL :: ([LaTeX] -> LaTeX) -> [l] -> l

It allows to lift any function over LaTeX to a function over any type l of the class, as follows:

fromLaTeX :: LaTeXC l => LaTeX -> l
fromLaTeX l = liftListL (\_ -> l) []

liftL :: LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL f x = liftListL (\[x] -> f x) [x]

liftL2 :: LaTeXC l => (LaTeX -> LaTeX -> LaTeX) -> l -> l -> l
liftL2 f x y = liftListL (\[x,y] -> f x y) [x,y]

And you can continue with number of arguments of your desire. For N arguments:

liftLN :: LaTeXC l => (LaTeX -> ... -> LaTeX) -> l -> ... -> l
liftLN f x1 ... xN = liftListL (\[x1 ... xN] -> f x1 ... xN) [x1 ... xN]

Now we are ready to express all functions changing each LaTeX with a type l instance of LaTeXC. The idea is to separate LaTeX arguments and other arguments and apply a liftLN function in the following way:

foo :: LaTeXC l => l -> A -> B -> l -> C -> l
foo l1 a b l2 c = liftL2 (\l1 l2 -> old l1 a b l2 c) l1 l2
 where
  old :: LaTeX -> A -> B -> LaTeX -> C -> LaTeX

Here, the function old is the original definition of foo. There are plenty of examples in the library (all funcions are now defined this way). As a contributor you may want to see it.

Since LaTeX and LaTeXT are instances of LaTeXC, now all functions work at the same time for both types.

The User's Guide

I started to write the HaTeX User's Guide. I'm doing it open source. It contains an introduction and explain some basics of HaTeX. The source code repository lives here.

The release in Hackage will be done when the User's Guide becomes more complete.

Saturday, April 21, 2012

Parsing with Haskell

I really LOVE to create parsers in Haskell!

Below, an example of a simple markdown parser (using the parsec library).

module Syntax (
   Syntax (..)
 , Text
 , parseSyntax
 , ParseError
   ) where

import Data.Text
import Data.String
import Text.Parsec
import Text.Parsec.Text
import Control.Monad (join)

{- Syntax Table

Italic: /.../
Bold: *...*
Language switch: $...$
Quote: {...}
Link: <...|...>
Image: [...]
Paragraph: |...|
Big: ^...^

-}

data Syntax =
   Raw Text
 | Italic Syntax
 | Bold Syntax
 | Lang Syntax
 | Quote Syntax
 | Link Text Text
 | Image Text
 | Par Syntax
 | Big Syntax
 | Seq Syntax Syntax
   deriving Show -- For debugging

reschars :: [Char]
reschars = "/*${}<>[]|^"

p_Syntax :: Parser Syntax
p_Syntax = fmap (Prelude.foldr1 Seq) $ many1 $ choice $ fmap try [
   p_Raw
 , p_Chars   Italic '/'     '/'
 , p_Chars   Bold   '*'     '*'
 , p_Chars   Lang   '$'     '$'
 , p_Chars   Quote  '{'     '}'
 , p_CharsT2 Link   '<' '|' '>'
 , p_CharsT  Image  '['     ']'
 , p_Chars   Par    '|'     '|'
 , p_Chars   Big    '^'     '^'
   ]

parseSyntax :: Text -> Either ParseError Syntax
parseSyntax = parse (withEOF p_Syntax) "SyntaxSource"

----------------------------------------------------

p_Chars :: (Syntax -> a) -> Char -> Char -> Parser a
p_Chars f c1 c2 = fmap f $ between (char c1) (char c2) $ p_Syntax

p_CharsT :: (Text -> a) -> Char -> Char -> Parser a
p_CharsT f c1 c2 = char c1 >> (fmap (f . fromString) $ many1 $ noneOf [c2])
                           >>= (char c2 >>) . return

p_CharsT2 :: (Text -> Text -> a) -> Char -> Char -> Char -> Parser a
p_CharsT2 f c1 c c2 = do
 char c1
 l <- many1 $ noneOf [c] 
 char c
 s <- many1 $ noneOf [c2]
 char c2
 return $ f (fromString l) (fromString s)

p_Raw :: Parser Syntax
p_Raw = fmap (Raw . fromString) $ many1 $
           try (char '\\' >> choice (fmap char reschars))
       <|> noneOf reschars

withEOF :: (Stream s m t, Show t) => ParsecT s u m b -> ParsecT s u m b
withEOF = (>>= (eof >>) . return)

Sunday, April 15, 2012

HaTeX: Trees and problems

Trees

Since a time ago, I wanted to add trees to HaTeX. Some way to, given a Haskell tree, create a LaTeX output according to it. So I created the datatype:

data Tree a =
   Leaf a
 | Node (Maybe a) [Tree a]

and started thinking about what LaTeX package I should to use in order to drawing trees. Since there are several good options, I decided to keep the Tree datatype in a separated module and write different implementations in different modules with similar interfaces. Then, I started with the qtree package and, in a few minutes, I had an example working. So I was happy for the moment.

The problem

But my happiness did not last long. The method used to transform a Haskell tree into a LaTeX value was to have a function that creates a LaTeX value from each node and, then, build the tree following the LaTeX tree syntax. So, the type of the function, called tree, was:

tree :: (a -> LaTeX) -> Tree a -> LaTeX

And this worked pretty well. The problem came out when I wanted to run metahatex in order to create the analogous monadic version. The modus operandi of metahatex is to read the type of the functions and infer from it their monadic implementation, re-using the original implementation. For example, if we have:

foo :: LaTeX -> a -> LaTeX

then, metahatex (importing the former qualified as App) do:

foo :: Monad m => LaTeXT_ m -> a -> LaTeXT_ m
foo lm a = do
 l <- extractLaTeX_ lm
 textell $ App.foo l a

where extractLaTeX_ gets the LaTeX value produced by the LaTeXT monad and textell puts LaTeX values again in the monad (like the tell method of the writer monad).

This method has worked perfectly until now. But, what happens if we try to apply it to the tree function? As we needed to transform a value of type LaTeX to another of type LaTeXT_ m for foo, we will need to do so from a a -> LaTeXT_ m typed value to a a -> LaTeX typed value. And that is impossible!

Searching a solution

I never liked the idea of write the monadic code manually, that would be write duplicated code. I went then to eat a pizza and think about it. Typeclasses came to my mind. When I returned to my computer, I started to search what minimal functions I need to render the tree. Then, I wrote a typeclass and made LaTeX and LaTeXT_ instances of it. See the definition of the resulting typeclass:

class (Monoid l, IsString l) => LaTeXTree l where
  texbraces :: l -> l
  texcomms :: String -> l
  totex :: Render a => a -> l

The first and second method are abstractions of the TeXBraces and TeXCommS type constructors! And the other is the abstraction of the rendertex function! Making LaTeX and LaTeXT instances of this typeclass allow us to construct a tree function valid to both types. But this is not the end. The same idea is applicable to the whole library, so normal and .Monad modules can be merged using a typeclass with abstractions of all LaTeX constructors!

Conclusion

Well, this idea had come to me a time ago, but I just realized today how useful it can be. And now, I feel a bit odd taking this approach only to trees. What should I do?

Monday, February 20, 2012

HaTeX: Chapter 3.2

It's time for a new release of HaTeX: the version 3.2, as announced in my previous post. I'm glad each time I see my library get better. Although the major version is increased again, I expect backwards compatibility, in spite of the changes done in some type signatures. I have tried to get previous code working.

Get HaTeX 3.2 from Hackage: http://hackage.haskell.org/package/HaTeX-3.2.

This is how HaTeX has changed this time.

The LaTeX Parser

It makes me happy to get working a parser of LaTeX. I have tested it with some examples (for instance, with the "fibs.hs" example, included in the library) with a reasonable output. Anyway, the parser is not mature yet. Future working on it will be done when a bugged output is found parsing some LaTeX code.

Greek alphabet

The AMSMath module is still very incomplete, but now it contains the entire greek alphabet.

The graphicx package

A new module with a new LaTeX package has been added. This time was for the graphicx package. The point here is to get all to be done with types, wherever possible. The way to achieve this is to define datatypes that will force you to put correct arguments to the functions. So the includegraphics function receives a [IGOption] and a FilePath as arguments, where each IGOption is a typed representation of each valid argument for includegraphics.

Changes in documentclass

Until now, documentclass function had type:

documentclass :: [LaTeX] -> String -> LaTeX

So if you want to set the font size to 12pt, you had to do:

documentclass [rendertex $ Pt 12]

or to do the trick:

documentclass ["12pt"]

which looks quite dirty.

Following my all-typed approach, I defined a new datatype (ClassOption) for documentclass arguments. This way, the former get done like this:

documentclass [FontSize $ Pt 12]

I find this more correct. Anyway, the second way still work, while the first one don't.

Other minor changes

Other minor changes have been done, like GHC 7.4 compatibility (thanks to Alexey Khudyakov) or addition of some new functions. To view a complete list see the commit history of the library.

Thursday, February 2, 2012

News about HaTeX

A lot of news about HaTeX have happened since the last time I wrote here about it. I want to sum up all of them now, with the 3.2 version release in mind.

HaTeX-3.1.0 and warnings

There was a release of the version 3.1.0 (along HaTeX-meta-1.1.0). It was announced in Haskell-Cafe [1].

The key novelty in this release is the incorporation of Warnings. Warnings are data generated from a LaTeX value checking. They give you information about your LaTeX value (e.g. if you skipped the document environment, or if you called to an undefined label). They are called "Warnings" instead of "Error" because they won't stop the execution.

Other new features are: Num instance for LaTeX and LaTeXT, an implementation of the LaTeX AMSThm package and a directory with examples (currently only one) shipped with the package.

HaTeX-3.2

The next release will be the 3.2 version.

The main new feature is a LaTeX code parser. This means you can read a file with LaTeX code and get its AST in Haskell! Although is still uncompleted and untested, I'm sure this feature will become HaTeX in a more complete library.

Before the release, I want to ask: what do you think this new version must to have?

HaTeX closer

In order to make easier collaboration of developers, I hosted the HaTeX code in GitHub [2]. And I already receiving contributions!

It also was very useful to place all together the code repository, an issue tracker and a wiki. So, if you are interested in HaTeX, feel free to contribute by any of the ways.

A mailing list [3] is also open to everybody, so we can discuss there about any topic related someway to HaTeX.

I also created a Twitter account for HaTeX-related tweets [4].

As you can see, there are a lot of ways to being connected with this project! I have done this to make easier as possible contributions in the future.

The lack of a manual

But not all news are good! HaTeX still lacks a manual. I have been writing one, but I stopped a while ago and I'm thinking now to continue this work. Sorry for this!

Thanks

Finally, I want to say thanks to all people who has contributed in some way. Thanks!

References

[1] - Announce of HaTeX 3.1.0 in Haskell-Cafe: http://www.haskell.org/pipermail/haskell-cafe/2011-December/097416.html
[2] - HaTeX in Github: https://github.com/Daniel-Diaz/HaTeX
[3] - HaTeX mailing list: http://projects.haskell.org/cgi-bin/mailman/listinfo/hatex
[4] - HaTeX Twitter account: https://twitter.com/HaTeX_updates