Format parser for hledger

Format.hs

-- This is hledger-lib/Hledger/Read/Format.hs 

module Hledger.Read.Format where

import Numeric
import Data.Maybe
import Test.HUnit
import Text.ParserCombinators.Parsec hiding (spaces)

{-
%[-][MIN WIDTH][.MAX WIDTH]EXPR

%-P     a transaction's payee, left justified
%20P    The same, right justified, at least 20 chars wide
%.20P   The same, no more than 20 chars wide
%-.20P  Left justified, maximum twenty chars wide
-}

data FormatString 
  = FormatLiteral String
  | FormatField 
    Bool            -- Left justified 
    (Maybe Int)     -- Min width
    (Maybe Int)     -- Max width
    Char            -- EXPR
    deriving (Show, Eq)

text :: Parser Char
text = letter

formatField :: Parser FormatString
formatField = do
    char '%'
    leftJustified <- optionMaybe (char '-')
    minWidth <- optionMaybe (many1 $ digit)
    let
      min = case minWidth of
        Just text -> Just m where ((m,_):_) = readDec text
        _ -> Nothing
    maxWidth <- optionMaybe (do char '.'; many1 $ digit)
    let
      max = case maxWidth of
        Just text -> Just m where ((m,_):_) = readDec text
        _ -> Nothing
    field <- letter
    return $ FormatField (isJust leftJustified) min max field

formatLiteral :: Parser FormatString
formatLiteral = do
    s <- many1 c
    return $ FormatLiteral s
    where
      c =     noneOf "%"
          <|> try (string "%%" >> return '%')

formatString :: Parser FormatString
formatString =
        formatField
    <|> formatLiteral

parseFormatString :: String -> Either ParseError [FormatString]
parseFormatString input = parse (many formatString) "(unknown)" input

testParser :: String -> [FormatString] -> Assertion
testParser s expected = case (parseFormatString s) of
    Left  error -> assertFailure $ show error
    Right actual -> assertEqual ("Input: " ++ s) expected actual

tests = test [
      testParser "" []
    , testParser "P" [FormatLiteral "P"]
    , testParser "%P" [FormatField False Nothing Nothing 'P']
    , testParser "Hello %P!" [FormatLiteral "Hello ", FormatField False Nothing Nothing 'P', FormatLiteral "!"]
    , testParser "%-P" [FormatField True Nothing Nothing 'P']
    , testParser "%20P" [FormatField False (Just 20) Nothing 'P']
    , testParser "%.10P" [FormatField False Nothing (Just 10) 'P']
    , testParser "%20.10P" [FormatField False (Just 20) (Just 10) 'P']
  ]