hs2lhs

tl;dr Here is the code to convert hs to lhs

Often I decide to write a blog post based on some haskell code that I have already written in normal (.hs) form. Had I known before writing the code that it would become a blog post I would have written it using the literate haskell (.lhs) format. So I wrote this small program to convert .hs to .lhs

Although the script is short (probably over golfed), it does demonstrate some nice haskell features.

Overloaded Strings and Data.Text

The ghc OverLoadedStrings language extension allows you to use string literals as text literals so you don’t have to convert String to Text.

> {-# LANGUAGE OverloadedStrings #-}

Multi-way if-expressions

Multi-way if-expressions allow the use of the guard syntax we commonly see for top level functions in if statements:

if | cond1 -> expr1
   | cond2 -> expr2
      ...
   | condn -> exprn

> {-# LANGUAGE MultiWayIf        #-}

> module Main where
>
> import            Control.Applicative ((<$>), (<|>))
> import            Data.Maybe          (fromMaybe)
> import            Data.Text           (Text, stripStart, stripPrefix,
>                                        isPrefixOf, isSuffixOf)
> import qualified  Data.Text           as T
> import qualified  Data.Text.IO        as T
> import            System.Environment

In order to handle line breaks, we need to keep track of whether or not the last line parsed was a comments or code.

> data Tag = Comment | Code

Applicative and Alternative

The core of the program is the lhsLine function which converts each line in the .hs file to a line in the .lhs file and keeps track of the Tag. The stripPrefix function from Data.Text returns the input text stripped of a prefix as a Maybe value. It returns Nothing if the prefix does not match beginning of the text. We use fmap (<$>) to pair this result with its Tag inside the Maybe and the Alternative instance of Maybe (<|>) to choose the first Just value (or Nothing) if neither alternative matches.

> lhsLine :: Tag -> Text -> (Tag, Text)
> lhsLine w t = fromMaybe d c
>   where
>     d = if | t == T.empty -> (Code, "")
>            | isPrefixOf "{-#" t &&
>              isSuffixOf "#-}" t -> (Code, "> " `T.append` t)
>            | otherwise -> (Code, s `T.append` t)
>     s = case w of {Comment -> "\n> "; Code -> "> "}
>     c = stripC "-- |" t <|> stripC "--"  t
>     stripC p t = (\x -> (Comment, stripStart x)) <$> stripPrefix p t

We could use the State monad but it would be overkill. Simply threading the state (Tag) through as an argument is fine.

> lhs :: Tag -> [Text] -> [Text]
> lhs _ [] = []
> lhs c (t:ts) = t' : (lhs c' ts)
>   where (c', t') = lhsLine c t

> main = do
>   text <- T.readFile . head =<< getArgs
>   let p = T.lines text
>   mapM_ T.putStrLn (lhs Code p)

Give it a try!