better data type

This commit is contained in:
Joey Hess 2011-12-22 19:56:31 -04:00
parent 06bafae9e0
commit a0872a8ec3
2 changed files with 40 additions and 50 deletions

View file

@ -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 }
{- A format consists of a list of fragments. -}
type Format = [Frag]
{- A fragment is either a constant string, or a variable, with a padding. -}
data Frag = Const String | Var String Padding
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)
{- Positive padding is right justification; negative padding is left
- justification. -}
type Padding = Int
newFormat :: Format
newFormat = Format [] ""
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

View file

@ -435,8 +435,8 @@ subdirectories).
* --format=value
Specifies a custom output format. The value is a format string,
in which '${var}' is expanded to the value of a variable. To right-align
a variable with whitespace, use '${var;width}' ; to left-align
in which '${var}' is expanded to the value of a variable. To right-justify
a variable with whitespace, use '${var;width}' ; to left-justify
a variable, use '${var;-width}'. Also, '\n' is a newline, '\0' is a NULL,
etc.