add a text formatter

This is built for speed; a format string is parsed once, generating a
Format, that can be applied repeatedly to different sets of variables
to generate output.

1 files changed, 94 insertions, 0 deletions

diff --git a/Utility/Format.hs b/Utility/Format.hs
new file mode 100644
index 000000000..a49d95ff8
--- /dev/null
+++ b/Utility/Format.hs
@@ -0,0 +1,94 @@
+{- Formatted string handling.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Format (gen, format) where
+
+import Text.Printf (printf)
+import Data.String.Utils (replace)
+import Data.Char (isAlphaNum)
+import qualified Data.Map as M
+import Data.Maybe
+
+import Utility.PartialPrelude
+
+type FormatString = String
+
+{- A format consists of a list of fragments, with other text suffixed to
+ - the end. -}
+data Format = Format { spans :: [Frag], suffix :: String }
+	deriving (Show)
+
+{- A fragment is a variable (which may be padded), prefixed by some text. -}
+data Frag = Frag { prefix :: String, varname :: String, pad :: Int }
+	deriving (Show)
+
+newFormat :: Format
+newFormat = Format [] ""
+
+{- Expands a Format using some variables, generating a formatted string.
+ - This can be repeatedly called, efficiently. -}
+format :: Format -> M.Map String String -> String
+format f vars = concat $ concat $ reverse $ [suffix f] : go (spans f) []
+	where
+		go [] c = c
+		go (s:rest) c = go rest $ [prefix s, val s]:c
+		val (Frag { varname = var, pad = p }) =
+			justify p $ fromMaybe "" $ M.lookup var vars
+		justify p v
+			| p > 0 = take (p - length v) spaces ++ v
+			| p < 0 = v ++ take (-1 * (length v + p)) spaces
+			| otherwise = v
+		spaces = repeat ' '
+
+{- Generates a Format that can be used to expand variables in a
+ - format string, such as "${foo} ${bar}\n"
+ -
+ - To handle \n etc, printf is used, first escaping %, to
+ - avoid it needing any printf arguments.
+ -
+ - Left padding is enabled by "${var;width}"
+ - Right padding is enabled by "${var;-width}"
+ -
+ - (This is the same type of format string used by dpkg-query.)
+ -}
+gen :: FormatString -> Format
+gen = scan newFormat . printf . escapeprintf
+	where
+		escapeprintf = replace "%" "%%"
+		-- The Format is built up with fields reversed, for
+		-- efficiency.
+		finalize f v = f
+			{ suffix = (reverse $ suffix f) ++ v
+			, spans = (reverse $ spans f)
+			}
+		scan f (a:b:cs)
+			| a == '$' && b == '{' = invar f [] cs
+			| otherwise = scan f { suffix = a:suffix f } (b:cs)
+		scan f v = finalize f v
+		invar f var [] = finalize f $ novar var
+		invar f var (c:cs)
+			| c == '}' = foundvar f var 0 cs
+			| isAlphaNum c = invar f (c:var) cs
+			| c == ';' = inpad "" f var cs
+			| otherwise = scan f { suffix = (reverse $ novar $ c:var) ++ suffix f } cs
+		inpad p f var (c:cs)
+			| c == '}' = foundvar f var (readpad $ reverse p) cs
+			| otherwise = inpad (c:p) f var cs
+		inpad p f var [] = finalize f $ novar $ p++";"++var
+		readpad = fromMaybe 0 . readMaybe
+		novar v = "${" ++ reverse v
+		foundvar f v p cs = scan f' cs
+			where
+				f' = f
+					{ suffix = ""
+					, spans = newspan:spans f
+					}
+				newspan = Frag
+					{ prefix = reverse $ suffix f
+					, varname = reverse v
+					, pad = p
+					}