better data type

1 files changed, 38 insertions, 48 deletions

diff --git a/Utility/Format.hs b/Utility/Format.hs
index cde63f57c..5a74da96b 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -17,78 +17,68 @@ 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 format consists of a list of fragments. -}
+type Format = [Frag]
 
-{- A fragment is a variable (which may be padded), prefixed by some text. -}
-data Frag = Frag { prefix :: String, varname :: String, pad :: Int }
+{- A fragment is either a constant string, or a variable, with a padding. -}
+data Frag = Const String | Var String Padding
 	deriving (Show)
 
-newFormat :: Format
-newFormat = Format [] ""
+{- Positive padding is right justification; negative padding is left
+ - justification. -}
+type Padding = Int
+
+empty :: Frag -> Bool
+empty (Const "") = True
+empty _ = False
 
 {- 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) []
+format f vars = concatMap expand 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
+		expand (Const s) = s
+		expand (Var name padding) = justify padding $
+			fromMaybe "" $ M.lookup name vars
+		justify p s
+			| p > 0 = take (p - length s) spaces ++ s
+			| p < 0 = s ++ take (-1 * (length s + p)) spaces
+			| otherwise = s
 		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}"
+ - format string, such as "${foo} ${bar;10} ${baz;-10}\n"
  -
  - (This is the same type of format string used by dpkg-query.)
  -}
 gen :: FormatString -> Format
-gen = scan newFormat . printf . escapeprintf
+gen = finalize . scan []
 	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)
-			}
+		-- The Format is built up in reverse, for efficiency,
+		-- To finalize it, fix the reversing and do some
+		-- optimisations, including fusing adjacent Consts.
+		finalize = filter (not . empty) . fuse []
+		fuse f [] = f
+		fuse f (Const c1:Const c2:vs) = fuse f $ Const (c2++c1) : vs
+		fuse f (v:vs) = fuse (v:f) vs
+
 		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
+			| otherwise = scan (Const [a] : f ) (b:cs)
+		scan f v = Const v : f
+
+		invar f var [] = Const (novar var) : f
 		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
+			| otherwise = scan ((Const $ reverse $ novar $ c:var):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
+		inpad p f var [] = Const (novar $ p++";"++var) : f
 		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
-					}
+		foundvar f v p cs = scan (Var (reverse v) p : f) cs