1 module Hledger.Cli.Format (
    2           parseFormatString
    3         , formatStrings
    4         , formatValue
    5         , FormatString(..)
    6         , Field(..)
    7         , tests
    8         ) where
    9 
   10 import Numeric
   11 import Data.Char (isPrint)
   12 import Data.Maybe
   13 import Test.HUnit
   14 import Text.ParserCombinators.Parsec
   15 import Text.Printf
   16 
   17 
   18 data Field =
   19     Account
   20   | DefaultDate
   21   | Description
   22   | Total
   23   | DepthSpacer
   24   | FieldNo Int
   25     deriving (Show, Eq)
   26 
   27 data FormatString =
   28     FormatLiteral String
   29   | FormatField Bool        -- Left justified ?
   30                 (Maybe Int) -- Min width
   31                 (Maybe Int) -- Max width
   32                 Field       -- Field
   33   deriving (Show, Eq)
   34 
   35 formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String
   36 formatValue leftJustified min max value = printf formatS value
   37     where
   38       l = if leftJustified then "-" else ""
   39       min' = maybe "" show min
   40       max' = maybe "" (\i -> "." ++ (show i)) max
   41       formatS = "%" ++ l ++ min' ++ max' ++ "s"
   42 
   43 parseFormatString :: String -> Either String [FormatString]
   44 parseFormatString input = case (runParser formatStrings () "(unknown)") input of
   45     Left y -> Left $ show y
   46     Right x -> Right x
   47 
   48 {-
   49 Parsers
   50 -}
   51 
   52 field :: GenParser Char st Field
   53 field = do
   54         try (string "account" >> return Account)
   55     <|> try (string "depth_spacer" >> return DepthSpacer)
   56     <|> try (string "date" >> return Description)
   57     <|> try (string "description" >> return Description)
   58     <|> try (string "total" >> return Total)
   59     <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))
   60 
   61 formatField :: GenParser Char st FormatString
   62 formatField = do
   63     char '%'
   64     leftJustified <- optionMaybe (char '-')
   65     minWidth <- optionMaybe (many1 $ digit)
   66     maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit)
   67     char '('
   68     f <- field
   69     char ')'
   70     return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f
   71     where
   72       parseDec s = case s of
   73         Just text -> Just m where ((m,_):_) = readDec text
   74         _ -> Nothing
   75 
   76 formatLiteral :: GenParser Char st FormatString
   77 formatLiteral = do
   78     s <- many1 c
   79     return $ FormatLiteral s
   80     where
   81       isPrintableButNotPercentage x = isPrint x && (not $ x == '%')
   82       c =     (satisfy isPrintableButNotPercentage <?> "printable character")
   83           <|> try (string "%%" >> return '%')
   84 
   85 formatString :: GenParser Char st FormatString
   86 formatString =
   87         formatField
   88     <|> formatLiteral
   89 
   90 formatStrings :: GenParser Char st [FormatString]
   91 formatStrings = many formatString
   92 
   93 testFormat :: FormatString -> String -> String -> Assertion
   94 testFormat fs value expected = assertEqual name expected actual
   95     where
   96         (name, actual) = case fs of
   97             FormatLiteral l -> ("literal", formatValue False Nothing Nothing l)
   98             FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value)
   99 
  100 testParser :: String -> [FormatString] -> Assertion
  101 testParser s expected = case (parseFormatString s) of
  102     Left  error -> assertFailure $ show error
  103     Right actual -> assertEqual ("Input: " ++ s) expected actual
  104 
  105 tests = test [ formattingTests ++ parserTests ]
  106 
  107 formattingTests = [
  108       testFormat (FormatLiteral " ")                                ""            " "
  109     , testFormat (FormatField False Nothing Nothing Description)    "description" "description"
  110     , testFormat (FormatField False (Just 20) Nothing Description)  "description" "         description"
  111     , testFormat (FormatField False Nothing (Just 20) Description)  "description" "description"
  112     , testFormat (FormatField True Nothing (Just 20) Description)   "description" "description"
  113     , testFormat (FormatField True (Just 20) Nothing Description)   "description" "description         "
  114     , testFormat (FormatField True (Just 20) (Just 20) Description) "description" "description         "
  115     , testFormat (FormatField True Nothing (Just 3) Description)    "description" "des"
  116     ]
  117 
  118 parserTests = [
  119       testParser ""                             []
  120     , testParser "D"                            [FormatLiteral "D"]
  121     , testParser "%(date)"                      [FormatField False Nothing Nothing Description]
  122     , testParser "%(total)"                     [FormatField False Nothing Nothing Total]
  123     , testParser "Hello %(date)!"               [FormatLiteral "Hello ", FormatField False Nothing Nothing Description, FormatLiteral "!"]
  124     , testParser "%-(date)"                     [FormatField True Nothing Nothing Description]
  125     , testParser "%20(date)"                    [FormatField False (Just 20) Nothing Description]
  126     , testParser "%.10(date)"                   [FormatField False Nothing (Just 10) Description]
  127     , testParser "%20.10(date)"                 [FormatField False (Just 20) (Just 10) Description]
  128     , testParser "%20(account) %.10(total)\n"   [ FormatField False (Just 20) Nothing Account
  129                                                 , FormatLiteral " "
  130                                                 , FormatField False Nothing (Just 10) Total
  131                                                 , FormatLiteral "\n"
  132                                                 ]
  133   ]