finished where indentation changes
This commit is contained in:
Joey Hess
parent
b77290cecc
commit
f87a781aa6
68 changed files with 1619 additions and 1628 deletions
|
|
@ -43,19 +43,19 @@ type Variables = M.Map String String
|
|||
- This can be repeatedly called, efficiently. -}
|
||||
format :: Format -> Variables -> String
|
||||
format f vars = concatMap expand f
|
||||
where
|
||||
expand (Const s) = s
|
||||
expand (Var name j)
|
||||
| "escaped_" `isPrefixOf` name =
|
||||
justify j $ encode_c_strict $
|
||||
getvar $ drop (length "escaped_") name
|
||||
| otherwise = justify j $ getvar name
|
||||
getvar name = fromMaybe "" $ M.lookup name vars
|
||||
justify UnJustified s = s
|
||||
justify (LeftJustified i) s = s ++ pad i s
|
||||
justify (RightJustified i) s = pad i s ++ s
|
||||
pad i s = take (i - length s) spaces
|
||||
spaces = repeat ' '
|
||||
where
|
||||
expand (Const s) = s
|
||||
expand (Var name j)
|
||||
| "escaped_" `isPrefixOf` name =
|
||||
justify j $ encode_c_strict $
|
||||
getvar $ drop (length "escaped_") name
|
||||
| otherwise = justify j $ getvar name
|
||||
getvar name = fromMaybe "" $ M.lookup name vars
|
||||
justify UnJustified s = s
|
||||
justify (LeftJustified i) s = s ++ pad i s
|
||||
justify (RightJustified i) s = pad i s ++ s
|
||||
pad i s = take (i - length s) spaces
|
||||
spaces = repeat ' '
|
||||
|
||||
{- Generates a Format that can be used to expand variables in a
|
||||
- format string, such as "${foo} ${bar;10} ${baz;-10}\n"
|
||||
|
|
@ -64,37 +64,37 @@ format f vars = concatMap expand f
|
|||
-}
|
||||
gen :: FormatString -> Format
|
||||
gen = filter (not . empty) . fuse [] . scan [] . decode_c
|
||||
where
|
||||
-- The Format is built up in reverse, for efficiency,
|
||||
-- and can have many adjacent Consts. Fusing it fixes both
|
||||
-- problems.
|
||||
fuse f [] = f
|
||||
fuse f (Const c1:Const c2:vs) = fuse f $ Const (c2++c1) : vs
|
||||
fuse f (v:vs) = fuse (v:f) vs
|
||||
where
|
||||
-- The Format is built up in reverse, for efficiency,
|
||||
-- and can have many adjacent Consts. Fusing it fixes both
|
||||
-- problems.
|
||||
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 (Const [a] : f ) (b:cs)
|
||||
scan f v = Const v : f
|
||||
scan f (a:b:cs)
|
||||
| a == '$' && b == '{' = invar f [] cs
|
||||
| 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 UnJustified cs
|
||||
| isAlphaNum c || c == '_' = invar f (c:var) cs
|
||||
| c == ';' = inpad "" f var cs
|
||||
| otherwise = scan ((Const $ novar $ c:var):f) cs
|
||||
invar f var [] = Const (novar var) : f
|
||||
invar f var (c:cs)
|
||||
| c == '}' = foundvar f var UnJustified cs
|
||||
| isAlphaNum c || c == '_' = invar f (c:var) cs
|
||||
| c == ';' = inpad "" f var cs
|
||||
| otherwise = scan ((Const $ novar $ c:var):f) cs
|
||||
|
||||
inpad p f var (c:cs)
|
||||
| c == '}' = foundvar f var (readjustify $ reverse p) cs
|
||||
| otherwise = inpad (c:p) f var cs
|
||||
inpad p f var [] = Const (novar $ p++";"++var) : f
|
||||
readjustify = getjustify . fromMaybe 0 . readish
|
||||
getjustify i
|
||||
| i == 0 = UnJustified
|
||||
| i < 0 = LeftJustified (-1 * i)
|
||||
| otherwise = RightJustified i
|
||||
novar v = "${" ++ reverse v
|
||||
foundvar f v p = scan (Var (reverse v) p : f)
|
||||
inpad p f var (c:cs)
|
||||
| c == '}' = foundvar f var (readjustify $ reverse p) cs
|
||||
| otherwise = inpad (c:p) f var cs
|
||||
inpad p f var [] = Const (novar $ p++";"++var) : f
|
||||
readjustify = getjustify . fromMaybe 0 . readish
|
||||
getjustify i
|
||||
| i == 0 = UnJustified
|
||||
| i < 0 = LeftJustified (-1 * i)
|
||||
| otherwise = RightJustified i
|
||||
novar v = "${" ++ reverse v
|
||||
foundvar f v p = scan (Var (reverse v) p : f)
|
||||
|
||||
empty :: Frag -> Bool
|
||||
empty (Const "") = True
|
||||
|
|
@ -106,36 +106,34 @@ empty _ = False
|
|||
decode_c :: FormatString -> FormatString
|
||||
decode_c [] = []
|
||||
decode_c s = unescape ("", s)
|
||||
where
|
||||
e = '\\'
|
||||
unescape (b, []) = b
|
||||
-- look for escapes starting with '\'
|
||||
unescape (b, v) = b ++ fst pair ++ unescape (handle $ snd pair)
|
||||
where
|
||||
pair = span (/= e) v
|
||||
isescape x = x == e
|
||||
-- \NNN is an octal encoded character
|
||||
handle (x:n1:n2:n3:rest)
|
||||
| isescape x && alloctal = (fromoctal, rest)
|
||||
where
|
||||
alloctal = isOctDigit n1 &&
|
||||
isOctDigit n2 &&
|
||||
isOctDigit n3
|
||||
fromoctal = [chr $ readoctal [n1, n2, n3]]
|
||||
readoctal o = Prelude.read $ "0o" ++ o :: Int
|
||||
-- \C is used for a few special characters
|
||||
handle (x:nc:rest)
|
||||
| isescape x = ([echar nc], rest)
|
||||
where
|
||||
echar 'a' = '\a'
|
||||
echar 'b' = '\b'
|
||||
echar 'f' = '\f'
|
||||
echar 'n' = '\n'
|
||||
echar 'r' = '\r'
|
||||
echar 't' = '\t'
|
||||
echar 'v' = '\v'
|
||||
echar a = a
|
||||
handle n = ("", n)
|
||||
where
|
||||
e = '\\'
|
||||
unescape (b, []) = b
|
||||
-- look for escapes starting with '\'
|
||||
unescape (b, v) = b ++ fst pair ++ unescape (handle $ snd pair)
|
||||
where
|
||||
pair = span (/= e) v
|
||||
isescape x = x == e
|
||||
-- \NNN is an octal encoded character
|
||||
handle (x:n1:n2:n3:rest)
|
||||
| isescape x && alloctal = (fromoctal, rest)
|
||||
where
|
||||
alloctal = isOctDigit n1 && isOctDigit n2 && isOctDigit n3
|
||||
fromoctal = [chr $ readoctal [n1, n2, n3]]
|
||||
readoctal o = Prelude.read $ "0o" ++ o :: Int
|
||||
-- \C is used for a few special characters
|
||||
handle (x:nc:rest)
|
||||
| isescape x = ([echar nc], rest)
|
||||
where
|
||||
echar 'a' = '\a'
|
||||
echar 'b' = '\b'
|
||||
echar 'f' = '\f'
|
||||
echar 'n' = '\n'
|
||||
echar 'r' = '\r'
|
||||
echar 't' = '\t'
|
||||
echar 'v' = '\v'
|
||||
echar a = a
|
||||
handle n = ("", n)
|
||||
|
||||
{- Inverse of decode_c. -}
|
||||
encode_c :: FormatString -> FormatString
|
||||
|
|
@ -147,28 +145,28 @@ encode_c_strict = encode_c' isSpace
|
|||
|
||||
encode_c' :: (Char -> Bool) -> FormatString -> FormatString
|
||||
encode_c' p = concatMap echar
|
||||
where
|
||||
e c = '\\' : [c]
|
||||
echar '\a' = e 'a'
|
||||
echar '\b' = e 'b'
|
||||
echar '\f' = e 'f'
|
||||
echar '\n' = e 'n'
|
||||
echar '\r' = e 'r'
|
||||
echar '\t' = e 't'
|
||||
echar '\v' = e 'v'
|
||||
echar '\\' = e '\\'
|
||||
echar '"' = e '"'
|
||||
echar c
|
||||
| ord c < 0x20 = e_asc c -- low ascii
|
||||
| ord c >= 256 = e_utf c -- unicode
|
||||
| ord c > 0x7E = e_asc c -- high ascii
|
||||
| p c = e_asc c -- unprintable ascii
|
||||
| otherwise = [c] -- printable ascii
|
||||
-- unicode character is decomposed to individual Word8s,
|
||||
-- and each is shown in octal
|
||||
e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8])
|
||||
e_asc c = showoctal $ ord c
|
||||
showoctal i = '\\' : printf "%03o" i
|
||||
where
|
||||
e c = '\\' : [c]
|
||||
echar '\a' = e 'a'
|
||||
echar '\b' = e 'b'
|
||||
echar '\f' = e 'f'
|
||||
echar '\n' = e 'n'
|
||||
echar '\r' = e 'r'
|
||||
echar '\t' = e 't'
|
||||
echar '\v' = e 'v'
|
||||
echar '\\' = e '\\'
|
||||
echar '"' = e '"'
|
||||
echar c
|
||||
| ord c < 0x20 = e_asc c -- low ascii
|
||||
| ord c >= 256 = e_utf c -- unicode
|
||||
| ord c > 0x7E = e_asc c -- high ascii
|
||||
| p c = e_asc c -- unprintable ascii
|
||||
| otherwise = [c] -- printable ascii
|
||||
-- unicode character is decomposed to individual Word8s,
|
||||
-- and each is shown in octal
|
||||
e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8])
|
||||
e_asc c = showoctal $ ord c
|
||||
showoctal i = '\\' : printf "%03o" i
|
||||
|
||||
{- for quickcheck -}
|
||||
prop_idempotent_deencode :: String -> Bool
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue