diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Format.hs | 86 |
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 |