Added Haddock documentation

AStar.hs

@@ -10,9 +10,15 @@ import qualified Data.Map as M
 import Data.List (foldl')
 import Data.Maybe (fromJust)
 
--- A* algorithm: Find a path from initial node to goal node using a heuristic function.
--- Returns Nothing if no path found. Else returns Just (path cost, path).
-astar :: (Ord a, Ord b, Num b) => a -> a -> (a -> [(a, b)]) -> (a -> a -> b) -> Maybe (b, [a])
+-- | A* algorithm: Finds a path from initial node to goal node using a heuristic function.
+astar :: (Ord a, Ord b, Num b) =>
+         a                  -- ^ The start node
+         -> a               -- ^ The goal node
+         -> (a -> [(a, b)]) -- ^ The function to get the next nodes and their
+                            -- costs from a given node
+         -> (a -> a -> b)   -- ^ The heuristic function to estimate the cost of
+                            -- going from a give node to the target node
+         -> Maybe (b, [a])  -- ^ Nothing if no path found. Else @Just (path cost, path)@
 astar initNode goalNode nextNode hueristic =
   astar' (PQ.singleton (hueristic initNode goalNode) (initNode, 0))
          S.empty (M.singleton initNode 0) M.empty

AmazingMazes.hs

@@ -1,46 +1,48 @@
-{-
-  A solution to rubyquiz 31 (http://rubyquiz.com/quiz31.html).
+{-|
+  A solution to rubyquiz 31 (<http://rubyquiz.com/quiz31.html>).
 
-  Generate a rectangular maze given its width and height. The maze should be
-  solvable for any start and end positions and there should be only one possible
-  solution for any pair of start and end positions.
+  /Generate a rectangular maze given its width and height. The maze should be/
+  /solvable for any start and end positions and there should be only one possible/
+  /solution for any pair of start and end positions./
 
-  Generate the ASCII output representing the maze.
+  /Generate the ASCII output representing the maze./
 
-  Find the solution of the maze. Produce ASCII output to visualize the solution.
+  /Find the solution of the maze. Produce ASCII output to visualize the solution./
 
   The maze generation algorithm used is recursive backtracking and the maze
-  solution algorithm used is A*.
-
-  Usage: ./AmazingMazes <width> <height> <start_x> <start_y> <end_x> <end_y>
-          Coordinates are zero based.
-
-  abhinav@xj9:rubyquiz# bin/AmazingMazes 10 10 0 0 9 9
-  +---+---+---+---+---+---+---+---+---+---+
-  | s   >   v         |           |       |
-  +---+---+   +---+   +   +---+   +   +---+
-  | v   <   < |       |       |   |   |   |
-  +   +---+---+---+---+---+   +   +   +   +
-  | v                 |       |       |   |
-  +   +---+---+---+   +   +---+---+---+   +
-  | >   >   >   v |   |   |         >   v |
-  +---+---+---+   +   +   +---+---+   +   +
-  |       | v   < |       | >   >   ^ | v |
-  +   +   +   +---+---+---+   +---+---+   +
-  |   |   | >   >   >   >   ^ |       | v |
-  +   +---+---+---+---+---+---+   +---+   +
-  |   |       |               | v   <   < |
-  +   +   +   +   +   +   +---+   +---+---+
-  |   |   |       |   |   | v   < |       |
-  +   +   +---+---+   +---+   +---+   +---+
-  |       |       |   | v   < |           |
-  +   +---+   +   +   +   +---+---+---+   +
-  |           |   |     >   >   >   >   e |
-  +---+---+---+---+---+---+---+---+---+---+
-
-  Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
+  solution algorithm used is A* (from "AStar" module).
+
+  Usage (Coordinates are zero based):
+
+  > ./AmazingMazes <width> <height> <start_x> <start_y> <end_x> <end_y>
+
+  Example:
+
+  > abhinav@xj9:rubyquiz# bin/AmazingMazes 10 10 0 0 9 9
+  > +---+---+---+---+---+---+---+---+---+---+
+  > | s   >   v         |           |       |
+  > +---+---+   +---+   +   +---+   +   +---+
+  > | v   <   < |       |       |   |   |   |
+  > +   +---+---+---+---+---+   +   +   +   +
+  > | v                 |       |       |   |
+  > +   +---+---+---+   +   +---+---+---+   +
+  > | >   >   >   v |   |   |         >   v |
+  > +---+---+---+   +   +   +---+---+   +   +
+  > |       | v   < |       | >   >   ^ | v |
+  > +   +   +   +---+---+---+   +---+---+   +
+  > |   |   | >   >   >   >   ^ |       | v |
+  > +   +---+---+---+---+---+---+   +---+   +
+  > |   |       |               | v   <   < |
+  > +   +   +   +   +   +   +---+   +---+---+
+  > |   |   |       |   |   | v   < |       |
+  > +   +   +---+---+   +---+   +---+   +---+
+  > |       |       |   | v   < |           |
+  > +   +---+   +   +   +   +---+---+---+   +
+  > |           |   |     >   >   >   >   e |
+  > +---+---+---+---+---+---+---+---+---+---+
+
+  Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 -}
-
 {-# LANGUAGE BangPatterns, TupleSections #-}
 
 module AmazingMazes (Cell(..), Maze(..), MazeSolution(..),
@@ -87,23 +89,23 @@ randomShuffle list = do
 
 -- maze --
 
--- a cell with x and y coordinates
+-- | A cell with x and y coordinates
 type Cell = (Int, Int)
 
--- a maze with width, height and a map of cell paths
+-- | A maze with width, height and a map of cell paths
 data Maze = Maze Int Int (M.Map Cell [Cell])
 
--- a solution to a maze with the start and end cells and the path map
+-- | A solution to a maze with the start and end cells and the path map
 data MazeSolution = MazeSolution Cell Cell (M.Map Cell Cell)
 
--- get the neighbour cells
+-- | Gets the neighbour cells
 nextCells :: Int -> Int -> Cell -> [Cell]
 nextCells width height (x, y) =
   filter (\(x', y') -> and [x' >= 0, x' < width, y' >= 0, y' < height])
   . map (\(xd, yd) -> (x + xd, y + yd))
   $ [(0,-1), (1,0), (0,1), (-1,0)]
 
--- generate a random maze given the start cell and an empty maze
+-- | Generates a random maze given the start cell and an empty maze
 generateMaze_ :: Cell -> Maze -> RandomState Maze
 generateMaze_ start maze@(Maze width height cellMap) = do
   !next <- randomShuffle . filter (not . flip M.member cellMap) $ nextCells width height start
@@ -118,26 +120,28 @@ generateMaze_ start maze@(Maze width height cellMap) = do
                 else return mz)
             maze next
 
--- generate a random maze given the maze width and height using recursive backtracking
-generateMaze :: Int -> Int -> RandomState Maze
+-- | Generates a random maze given the maze width and height using recursive backtracking
+generateMaze :: Int                  -- ^ Maze width
+                -> Int               -- ^ Maze height
+                -> State StdGen Maze -- ^ The generated maze inside a 'State' monad with a random generator
 generateMaze width height = do
   x <- getRandomR (0, width - 1)
   y <- getRandomR (0, height - 1)
   generateMaze_ (x, y) (Maze width height M.empty)
 
--- render a maze and its solution as a string
+-- | Renders a maze and its solution as a string
 renderMaze :: Maze -> MazeSolution -> String
 renderMaze maze@(Maze width height _) solution =
   concatMap (renderMazeRow maze solution) [0 .. (height - 1)]
   ++ concat (replicate width "+---") ++ "+"
 
--- render a row of a maze and the maze's solution as a string
+-- | Renders a row of a maze and the maze's solution as a string
 renderMazeRow :: Maze -> MazeSolution -> Int -> String
 renderMazeRow maze@(Maze width height _) solution rowIx =
   let (up, side) = unzip . map (renderMazeCell maze solution rowIx) $ [0 .. (width - 1)]
   in concat up ++ "+" ++ "\n" ++ concat side ++ "|" ++ "\n"
 
--- render a cell of a maze and the maze's solution as a pair of strings
+-- | Renders a cell of a maze and the maze's solution as a pair of strings
 renderMazeCell :: Maze -> MazeSolution -> Int -> Int -> (String, String)
 renderMazeCell (Maze _ _ cellMap) (MazeSolution start end solution) rowIx colIx = let
   cell = (colIx, rowIx)
@@ -155,12 +159,15 @@ renderMazeCell (Maze _ _ cellMap) (MazeSolution start end solution) rowIx colIx
                       Nothing -> " "
                       Just (x', y') -> fromMaybe " " $ M.lookup (x' - x, y' - y) marks
 
--- symbols to mark the solution path
+-- | Symbols to mark the solution path
 marks = M.fromList [((0,-1), "^"), ((1,0), ">"), ((0,1), "v"), ((-1,0), "<")]
 
--- solve the maze using A* given the maze and the start and end cells using
+-- | Solves the maze using A* given the maze and the start and end cells using
 -- Manhattan distance as the heuristic
-solveMaze :: Maze -> Cell -> Cell -> MazeSolution
+solveMaze :: Maze            -- ^ The maze to solve
+             -> Cell         -- ^ The start cell
+             -> Cell         -- ^ The end cell
+             -> MazeSolution -- ^ The solution of the maze
 solveMaze maze@(Maze _ _ cellMap) start end =
   MazeSolution start end
   . M.fromList
@@ -171,6 +178,9 @@ solveMaze maze@(Maze _ _ cellMap) start end =
   . astar start end (map (,1) . fromMaybe [] . flip M.lookup cellMap)
   $ (\(x, y) (x', y') -> abs (x - x') + abs (y - y'))
 
+-- | Reads the width, height, start and end cell co-ordinates from command
+-- line arguments, generates a maze using them, solves it and renders it
+-- with the solution.
 main = do
   (width : height : sx : sy : ex : ey : _) <- fmap (map read) getArgs
   g <- newStdGen

BarrelOfMonkeys.hs

@@ -1,7 +1,16 @@
-{-
-  A solution to rubyquiz 30 (http://rubyquiz.com/quiz30.html).
+{-|
+ A solution to rubyquiz 30 (http://rubyquiz.com/quiz30.html).
 
-  Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
+ /A "Barrel of Monkeys" playlist is when the next song in the playlist begins/
+ /with the same letter as the current song ended in./
+
+ /Given any starting and ending song, create a playlist that connects the two songs./
+ /Create playlists of specific durations and shortest and longest playlists by/
+ /the number of songs and the total duration./
+
+ /The song data is available at/ <http://rubyquiz.com/SongLibrary.xml.gz>.
+
+ Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 -}
 
 {-# LANGUAGE Arrows, NoMonomorphismRestriction, RecordWildCards #-}
@@ -30,11 +39,12 @@ import Text.XML.HXT.Core hiding ((:->), when)
 
 --- types ---
 
+-- | A song with all the fields
 data Song = Song {
-             songArtist :: T.Text,
-             songId :: Int,
-             songName :: T.Text,
-             songDuration :: Int
+             songArtist :: T.Text, -- ^ The song artist
+             songId :: Int,        -- ^ The song ID
+             songName :: T.Text,   -- ^ The song name
+             songDuration :: Int   -- ^ The song duration in milliseconds
             }
 
 instance Eq Song where
@@ -47,13 +57,18 @@ instance Show Song where
   show (Song {..}) = printf "%s. %s - %s (%sms)"
     (show songId) (T.unpack songArtist) (T.unpack songName) (show songDuration)
 
+-- | The whole song library
 data SongLibrary = SongLibrary {
                      songIdMap :: M.Map Int Song,
                      fstCharMap :: M.Map Char [Song],
                      lstCharMap :: M.Map Char [Song]
                    }
 
-data Playlist = Playlist { playlistSongs :: [Song], playlistDuration :: Int }
+-- | A playlist of songs
+data Playlist = Playlist {
+                  playlistSongs :: [Song], -- ^ The songs in the playlist
+                  playlistDuration :: Int  -- ^ The total duration of the playlist in milliseconds
+                }
 
 --- XML parsing ---
 
@@ -72,6 +87,7 @@ getSongs = atTag "Artist" >>>
     songs <- listA getSong -< a
     returnA -< map (uncurry3 $ Song sArtist) songs
 
+-- | Reads the song library from the XML file given its path
 getSongsFromXml :: FilePath -> IO SongLibrary
 getSongsFromXml file =
   fmap (uncurry3 SongLibrary
@@ -104,8 +120,13 @@ playlist library nextSong startId endId = do
   let pl = concatMap snd . maybeToList . astar start end nextSong $ (\_ _ -> 0)
   return $ Playlist pl (playlistTime pl)
 
+-- | Creates the shortest and longest playlist by the number of song and
+-- the shortest and longest playlist by the length of the playlist
 shortestPlaylist, longestPlaylist, shortestTimePlaylist, longestTimePlaylist
-  :: SongLibrary -> Int -> Int -> Maybe Playlist
+  :: SongLibrary       -- ^ The song library
+     -> Int            -- ^ The start song ID
+     -> Int            -- ^ The end song ID
+     -> Maybe Playlist -- ^ (@Just@ resultant playlist) if it exists else @Nothing@
 
 shortestPlaylist library =
   playlist library (\song -> map (\s -> (s, 1)) . nextSongs song $ library)
@@ -156,7 +177,16 @@ playlistTimes library startId endId = let
                       (distances, queue') prev
                in loop distances' queue''
 
-timedPlaylist :: SongLibrary -> Int -> Int -> Int -> Int -> Maybe Playlist
+-- | Creates a playlist with its duration as close a possible to the given duration
+timedPlaylist ::
+  SongLibrary       -- ^ The song library
+  -> Int            -- ^ The required duration in milliseconds
+  -> Int            -- ^ The start song ID
+  -> Int            -- ^ The end song ID
+  -> Int            -- ^ Maximum number of child nodes to consider while
+                    -- traversing the graph to create the playlist. Used for
+                    -- tuning the runtime of the function
+  -> Maybe Playlist -- ^ (@Just@ resultant playlist) if it exists else @Nothing@
 timedPlaylist library time startId endId maxChild =
   fst $ timedPlaylist_ library time startId endId S.empty M.empty
                        (playlistTimes library startId endId) maxChild

Cryptograms.hs

@@ -1,14 +1,26 @@
-{-
+{-|
+  A solution to rubyquiz 13 (<http://rubyquiz.com/quiz13.html>).
+
   Decrypts a cryptogram (a substitution cypher).
-  A solution to rubyquiz 13 (http://rubyquiz.com/quiz13.html).
-  Usage: ./Cryptograms dictionary_file encrypted_file num_max_mappings
 
-  Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
+  The decryption mapping is created by finding the words from the dictionary which have
+  the same form as the given token to translates, using the words to create partial
+  mappings and then merging these partial mappings to get more complete mappings.
+
+  Similarly, the partial mappings for all tokens are merged together to get the
+  complete mapping. The mappings are scored by how many tokens they are able to
+  translated successfully into dictionary words.
+
+  Usage:
+
+  > ./Cryptograms <dictionary_file> <encrypted_file> <num_max_mappings>
+
+  Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 -}
 
 {-# LANGUAGE BangPatterns #-}
 
-module Cryptograms (Mapping, Dict, readDict, translateToken,
+module Cryptograms (Mapping, Token, Dict, readDict, translateToken,
                     scoreMapping, findBestMappings, showMapping, main)
 where
 
@@ -26,11 +38,16 @@ import Text.Printf (printf)
 trace :: String -> a -> a
 trace _ x = x
 
+-- | A mapping between two alphabets.
 type Mapping = M.Map Char Char
 
+-- | An encrypted token.
+type Token = String
+
+-- | The dictionary of words.
 newtype Dict = Dict (M.Map Int (S.Set String))
 
--- reads the dictionary from the given file. must contain one word per line.
+-- | Reads the dictionary from the given file. Must contain one word per line.
 readDict :: FilePath -> IO Dict
 readDict filePath = do
   !dictWords <- fmap (filter (all isAlpha) . map (map toLower) . lines)
@@ -39,40 +56,46 @@ readDict filePath = do
     foldl' (\dict w -> M.insertWith S.union (length w) (S.singleton w) dict)
           M.empty dictWords
 
--- translates the token using the given mapping.
--- return Nothing if unable to translate.
-translateToken :: Mapping -> String -> Maybe String
+-- | Translates the token using the given mapping.
+-- Returns @Nothing@ if unable to translate.
+translateToken :: Mapping -> Token -> Maybe String
 translateToken mapping = fmap reverse
   . foldM (\acc char -> M.lookup char mapping >>= Just . (:acc)) ""
 
--- translates all tokens using the given mapping.
--- translates the token to '---' if unable to translate.
-translateTokens :: Mapping -> [String] -> [String]
+-- Translates all tokens using the given mapping.
+-- Translates the token to '---' if unable to translate.
+translateTokens :: Mapping -> [Token] -> [String]
 translateTokens mapping =
   map (\token ->
         fromMaybe (replicate (length token ) '-') . translateToken mapping $ token)
 
--- checks if the given word is in the dictionary.
+-- Checks if the given word is in the dictionary.
 inDict :: Dict -> String -> Bool
 inDict (Dict dict) word =
   case M.lookup (length word) dict of
     Nothing -> False
     Just ws -> word `S.member` ws
 
--- scores a mapping by counting the number of translated tokens that are
+-- | Scores a mapping by counting the number of translated tokens that are
 -- in the dictionary.
-scoreMapping :: Dict -> Mapping -> [String] -> Int
+scoreMapping :: Dict        -- ^ The dictionary
+                -> Mapping  -- ^ The mapping to score
+                -> [Token]  -- ^ The tokens to translate
+                -> Int      -- ^ The score of the mapping
 scoreMapping dict mapping =
   length . filter (inDict dict) . mapMaybe (translateToken mapping)
 
--- scores multiple mappings and returns an assoc list sorted by descending score.
-scoreMappings :: Dict -> [String] -> [Mapping] -> [(Mapping, Int)]
+-- Scores multiple mappings and returns an assoc list sorted by descending score.
+scoreMappings :: Dict -> [Token] -> [Mapping] -> [(Mapping, Int)]
 scoreMappings dict tokens =
   reverse . sortBy (comparing snd)
   . map (\mapping -> (mapping, scoreMapping dict mapping tokens))
 
--- finds maximum num mappings which have best scores for the given tokens.
-findBestMappings :: Dict -> Int -> [String] -> [Mapping]
+-- | Finds n best mappings which have best scores for the given tokens.
+findBestMappings :: Dict          -- ^ The dictionary
+                    -> Int        -- ^ Maximum number of mappings to consider
+                    -> [Token]    -- ^ The tokens to translate
+                    -> [Mapping]  -- ^ The mappings with best scores
 findBestMappings dict num tokens = let
   mappings = scoreMappings dict tokens
              . S.toList
@@ -86,8 +109,8 @@ findBestMappings dict num tokens = let
   maxScore = if not (null mappings) then snd . head $ mappings else 0
   in map fst . takeWhile ((== maxScore) . snd) $ mappings
 
--- finds the merged mappings for a token
-findMappingsForToken :: Dict -> S.Set Mapping -> String  -> S.Set Mapping
+-- Finds the merged mappings for a token
+findMappingsForToken :: Dict -> S.Set Mapping -> Token  -> S.Set Mapping
 findMappingsForToken dict mappings token =
   case find (inDict dict) . mapMaybe (flip translateToken token)
        . reverse . sortBy (comparing M.size)
@@ -99,7 +122,7 @@ findMappingsForToken dict mappings token =
     -- with the mappings for the token.
     Nothing -> mergeMappingLists mappings (createMappingsForToken dict token)
 
--- merges mapping lists. discards conflicting mappings while merging.
+-- Merges mapping lists. discards conflicting mappings while merging.
 mergeMappingLists :: S.Set Mapping -> S.Set Mapping -> S.Set Mapping
 mergeMappingLists mappings1 mappings2
   | mappings1 == S.empty = mappings2
@@ -113,7 +136,7 @@ mergeMappingLists mappings1 mappings2
                 [mergeMappings m1 m2 | m1 <- S.toList mappings1, m2 <- S.toList mappings2]]
         in trace (printf "Merged to %s mappings" (show $ S.size merged)) merged
 
--- merges two mappings. returns Nothing if mappings conflict.
+-- Merges two mappings. returns Nothing if mappings conflict.
 mergeMappings :: Mapping -> Mapping -> Maybe Mapping
 mergeMappings mapping1 mapping2 =
   foldM
@@ -123,8 +146,8 @@ mergeMappings mapping1 mapping2 =
         else Just $ M.insert k v acc)
     mapping1 $ M.toList mapping2
 
--- creates mappings for a token by finding words of same form from the dictionary.
-createMappingsForToken :: Dict -> String -> S.Set Mapping
+-- Creates mappings for a token by finding words of same form from the dictionary.
+createMappingsForToken :: Dict -> Token -> S.Set Mapping
 createMappingsForToken (Dict dict) token =
   case M.lookup (length token) dict of
     Nothing -> S.empty
@@ -134,9 +157,9 @@ createMappingsForToken (Dict dict) token =
                 . filter ((== tokenF) . tokenForm) . S.toList $ words
       in trace (printf "%s -> %s matches" token (show . S.size $ matches)) matches
 
--- returns form of a token. for example, the form of "abc" is [1,2,3]
+-- Returns form of a token. for example, the form of "abc" is [1,2,3]
 -- while the form of "aba" is [1,2,1].
-tokenForm :: String -> [Int]
+tokenForm :: Token -> [Int]
 tokenForm token = let
   (_, form, _) =
     foldl' (\(formMap, form, lf) char ->
@@ -146,11 +169,11 @@ tokenForm token = let
            (M.empty, [], 0) token
   in reverse form
 
--- creates the mapping between two strings of same length.
+-- Creates the mapping between two strings of same length.
 getMapping :: String -> String -> Mapping
 getMapping t1 t2 = M.fromList $ zip t1 t2
 
--- returns text representation of a mapping.
+-- | Returns text representation of a mapping.
 showMapping :: Mapping -> String
 showMapping mapping =
   map snd . sortBy (comparing fst) . M.toList

DiceRoller.hs

@@ -1,22 +1,24 @@
-{-
-  A solution to rubyquiz 61 (http://rubyquiz.com/quiz61.html).
+{-|
+  A solution to rubyquiz 61 (<http://rubyquiz.com/quiz61.html>).
 
-  The task for this Quiz is to write a dice roller. The program should take
-  two arguments: a dice expression followed by the number of times to roll it
-  (being optional, with a default of 1).
+  /The task for this Quiz is to write a dice roller. The program should take/
+  /two arguments: a dice expression followed by the number of times to roll it/
+  /(being optional, with a default of 1)./
 
-  The solution is done using Parsec for parsing the expression into an AST and
+  The solution is done using 'Parsec' for parsing the expression into an AST and
   then evaluating it recursively.
 
-  Usage: bin/DiceRoller "(5d5-4)d(16/d4)+3" 10
-         bin/DiceRoller 3d3
+  Usage:
 
-  Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
+  > bin/DiceRoller "(5d5-4)d(16/d4)+3" 10
+  > bin/DiceRoller 3d3
+
+  Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 -}
 
 {-# LANGUAGE NoMonomorphismRestriction #-}
 
-module DiceRoller (RandomState, Expr(..), eval, expr, main) where
+module DiceRoller (Expr(..), eval, expr, main) where
 
 import Control.Applicative ((<$>), (<*), (*>), (<|>))
 import Control.Monad (foldM, liftM2, liftM, when)
@@ -28,9 +30,7 @@ import System.Environment (getArgs)
 
 -- Randomness setup for dice roll --
 
-type RandomState = State StdGen
-
-getRandomR :: Random a => (a, a) -> RandomState a
+getRandomR :: Random a => (a, a) -> State StdGen a
 getRandomR limits = do
   gen <- get
   let (val, gen') = randomR limits gen
@@ -39,18 +39,19 @@ getRandomR limits = do
 
 -- AST --
 
--- Expression AST types
-data Expr = Lit Int       | -- An integer literal
-            Add Expr Expr | -- Binary addition
-            Sub Expr Expr | -- Binary subtraction
-            Mul Expr Expr | -- Binary multiplication
-            Div Expr Expr | -- Binary integer division
-            Rol Expr      | -- Unary single dice roll
-            MRol Expr Expr  -- Binary multiple dice rolls
+-- | Expression AST types
+data Expr = Lit Int       | -- ^ An integer literal
+            Add Expr Expr | -- ^ Binary addition
+            Sub Expr Expr | -- ^ Binary subtraction
+            Mul Expr Expr | -- ^ Binary multiplication
+            Div Expr Expr | -- ^ Binary integer division
+            Rol Expr      | -- ^ Unary single dice roll
+            MRol Expr Expr  -- ^ Binary multiple dice rolls
             deriving (Show)
 
--- Recursively evaluates the AST to get its value
-eval :: Expr -> RandomState Int
+-- | Recursively evaluates the AST to its value inside a 'State' monad with
+-- a random generator
+eval :: Expr -> State StdGen Int
 eval (Lit i)            = return i
 eval (Add e1 e2)        = liftM2 (+) (eval e1) (eval e2)
 eval (Sub e1 e2)        = liftM2 (-) (eval e1) (eval e2)
@@ -90,12 +91,12 @@ table = [[bop 'd' MRol AssocLeft],                       -- multiple rolls
          [bop '+' Add AssocLeft, bop '-' Sub AssocLeft]] -- addition and subtraction
   where bop c f = Infix (spaced (char c) *> return f)    -- binary operators
 
--- A parser to parse the full expression
+-- | A parser to parse the dice roll expression
 expr = buildExpressionParser table factor
 
 -- Main --
 
--- Reads the expression from program arguments, parses it and if successful,
+-- | Reads the expression from program arguments, parses it and if successful,
 -- evaluates the AST and displays the resultant values
 main = do
   args <- getArgs

EnglishNumerals.hs

@@ -1,10 +1,12 @@
-{-
-  A solution to rubyquiz 25 (http://rubyquiz.com/quiz25.html).
+{-|
+  A solution to rubyquiz 25 (<http://rubyquiz.com/quiz25.html>).
 
-  When the integers 1 to 10_000_000_000 are written in the English language,
-  then sorted as strings, which odd number appears first in the list?
+  /When the integers 1 to 10_000_000_000 are written in the English language,/
+  /then sorted as strings, which odd number appears first in the list?/
 
-  Usage: ./EnglishNumerals basis-file max_num
+  Usage:
+
+  > ./EnglishNumerals <basis_file> <max_num>
 
   Example basis file for English numerals:
 
@@ -43,7 +45,7 @@
   > 2, two
   > 1, one
 
-  Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
+  Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 -}
 
 module EnglishNumerals (Basis, readBasis, toEnglishNumerals, firstOddByEnglishNumeral, main)
@@ -56,12 +58,13 @@ import Data.Maybe (fromMaybe)
 import Data.List.Split (splitOn)
 import System.Environment (getArgs)
 
+-- | A basis is a list of basic numeral translations into a languages.
 type Basis = [(Integer, String)]
 
 isPowerOfTen :: Integer -> Bool
 isPowerOfTen = (== "10") . nub . show
 
--- reads the basis of the numeral system
+-- | Reads the basis of the numeral system
 readBasis :: FilePath -> IO Basis
 readBasis =
   fmap (map (\line -> let (n:en:_) = splitOn "," line in (read n, en)) . lines) . readFile
@@ -74,7 +77,7 @@ toEnglishNumeralsMemo basis n =
     then cache basis `Seq.index` (fromIntegral n -1)
     else toEnglishNumerals basis n
 
--- converts a number to its numeral representation in the given basis
+-- | Converts a number to its numeral representation in the given basis
 toEnglishNumerals :: Basis -> Integer -> String
 toEnglishNumerals basis n =
   unwords . words . go n (dropWhile ((> n) . fst) basis) $ ""
@@ -102,8 +105,8 @@ minEnglish basis start end step =
   maximumBy (flip $ comparing fst)
   . map (\x -> (toEnglishNumerals basis x, x)) $ [start, start + step .. end]
 
--- finds the first odd number and its representation between 1 and n which is
--- minimum by the lexicographically sorted representations
+-- | Finds the first odd number and its representation between 1 and the given number
+-- which is minimum by the lexicographically sorted representations
 firstOddByEnglishNumeral :: Basis -> Integer -> (String, Integer)
 firstOddByEnglishNumeral basis n =
   (\(eng, en) -> (unwords . words $ eng, en))

GedcomParser.hs

@@ -1,7 +1,10 @@
--- A GEDCOM to XML converter written using Parsec as a
--- solution for rubyquiz 6 (http://rubyquiz.com/quiz6.html).
+-- | A GEDCOM to XML converter written using Parsec as a
+-- solution for rubyquiz 6 (<http://rubyquiz.com/quiz6.html>).
+--
 -- Example GEDCOM document at
--- http://cpansearch.perl.org/src/PJCJ/Gedcom-1.16/royal.ged
+-- <http://cpansearch.perl.org/src/PJCJ/Gedcom-1.16/royal.ged>
+--
+-- Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 
 {-# LANGUAGE NoMonomorphismRestriction, RecordWildCards, FlexibleContexts #-}
 
@@ -18,7 +21,7 @@ data Line = Line {
                 lineId :: Maybe String
             }
 
--- an element in a GEDCOM document
+-- | An element in a GEDCOM document
 data Elem = Elem {
                 elemTag :: String,
                 elemValue :: Maybe String,
@@ -26,6 +29,7 @@ data Elem = Elem {
                 elemChildren :: [Elem]
             } deriving (Show)
 
+-- | A GEDCOM document
 type Doc = [Elem]
 
 indent n = concat . replicate n $ "  "
@@ -61,7 +65,7 @@ element level = do
             children <- many (element $ level + 1)
             return $ Elem lineTag lineValue lineId children
 
--- parses a document
+-- | Parser to parse a GEDCOM document from a 'String'
 document :: Stream s m Char => ParsecT s u m Doc
 document = element 0 `endBy` whitespaces
 
@@ -98,14 +102,14 @@ elemToXml indentation Elem{..} =
             ++ unlines (map (elemToXml (indentation + 1)) elemChildren)
             ++ indent indentation ++ "</" ++ elemTag ++ ">"
 
--- converts a document to XML
+-- | Converts a GEDCOM document to XML
 documentToXml :: Doc -> String
 documentToXml doc = "<DOCUMENT>\n"
     ++ (unlines . map (elemToXml 1) $ doc')
     ++ "</DOCUMENT>"
     where doc' = normalizeDoc doc
 
--- converts a GEDCOM document supplied through STDIN into XML
+-- | Converts a GEDCOM document supplied through STDIN into XML
 -- and prints to STDOUT
 main = do
     text <- getContents

KnightsTravails.hs

@@ -1,27 +1,28 @@
-{-
-  A solution to rubyquiz 27 (http://rubyquiz.com/quiz27.html).
+{-|
+  A solution to rubyquiz 27 (<http://rubyquiz.com/quiz27.html>).
 
-  Given a standard 8 x 8 chessboard where each position is indicated in algebraic
-  notation (with the lower left corner being a1), design a script that accepts
-  two or more arguments.
+  /Given a standard 8 x 8 chessboard where each position is indicated in algebraic/
+  /notation (with the lower left corner being a1), design a script that accepts/
+  /two or more arguments./
 
-  The first argument indicates the starting position of the knight. The second
-  argument indicates the ending position of the knight. Any additional arguments
-  indicate positions that are forbidden to the knight.
+  /The first argument indicates the starting position of the knight. The second/
+  /argument indicates the ending position of the knight. Any additional arguments/
+  /indicate positions that are forbidden to the knight./
 
-  Return an array indicating the shortest path that the knight must travel to
-  get to the end position without landing on one of the forbidden squares.
-  If there is no valid path to the destination return nil.
+  /Return an array indicating the shortest path that the knight must travel to/
+  /get to the end position without landing on one of the forbidden squares./
+  /If there is no valid path to the destination return nil./
 
-  Usage: ./KnightsTravails start_pos target_pos [blocked_pos]*
+  Usage:
 
-  Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
+  > ./KnightsTravails start_pos target_pos [blocked_pos]*
+
+  Copyright 2012 Abhinav Sarkar \<abhinav\@abhinavsarkar.net\>
 -}
 
 {-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-}
 
-module KnightsTravails (Square, Board(..), fromNotation, toNotation, isValidNotation,
-                        bfsSearch, astarSearch, main)
+module KnightsTravails (Square, fromNotation, toNotation, isValidNotation, search, main)
 where
 
 import qualified Data.Set as S
@@ -31,22 +32,22 @@ import Data.Maybe (fromJust)
 import Control.Arrow (second)
 import System.Environment (getArgs)
 
--- A square on the chess board
+-- | A square on the chess board
 type Square = (Int, Int)
 
 -- A chess board with the knight's current position and a set of blocked squares
 data Board = Board { knightPos :: Square, blockedSquares :: S.Set Square }
              deriving (Ord, Eq)
 
--- Converts a string in chess notation to a square. eg. a1 -> (1,1)
+-- | Converts a string in chess notation to a square. eg. a1 -> (1,1)
 fromNotation :: String -> Square
 fromNotation (x : y) = (fromJust (x `elemIndex` ['a'..'h']) + 1, read y)
 
--- Converts a square to a string in chess notation. eg. (1,1) -> a1
+-- | Converts a square to a string in chess notation. eg. (1,1) -> a1
 toNotation :: Square -> String
 toNotation (x, y) = ((['a'..'h'] !! (x - 1)) : "") ++ show y
 
--- Checks if a string is a valid chess notation
+-- | Checks if a string is a valid chess notation
 isValidNotation notation =
   and [length notation == 2,
        head notation `elem` ['a'..'h'],
@@ -71,14 +72,13 @@ knightAstar heuristic blockedSquares start target =
   $ astar (Board start blockedSquares) (Board target blockedSquares)
           nextKnightPos heuristic
 
--- Finds a path from a start square to an end square using BFS
-bfsSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square])
-bfsSearch = knightAstar (\_ _ -> 0)
-
--- Finds a path from a start square to an end square using AStar with
--- half of the max of coordinate deltas as the heuristic
-astarSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square])
-astarSearch =
+-- | Finds a path from a start square to an end square using A* with
+-- half of the max of coordinate deltas as the heuristic function
+search :: S.Set Square             -- ^ The set of blocked squares
+          -> Square                -- ^ The start square
+          -> Square                -- ^ The target square
+          -> Maybe (Int, [Square]) -- ^ The solution cost and path if found else 'Nothing'
+search =
   knightAstar (\(Board (x1,y1) _) (Board (x2,y2) _) ->
                   max (abs (x1-x2)) (abs (y1-y2)) `div` 2)
 
@@ -90,7 +90,7 @@ main = do
        then error "Invalid board position"
        else let
          (start : target : blocked) = args
-       in case astarSearch (S.fromList . map fromNotation $ blocked)
+       in case search (S.fromList . map fromNotation $ blocked)
                            (fromNotation start) (fromNotation target) of
           Just (_, path) -> putStrLn . unwords . map toNotation $ path
           Nothing -> putStrLn "No path found"