summaryrefslogtreecommitdiff
path: root/Utility/Format.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/Format.hs')
-rw-r--r--Utility/Format.hs79
1 files changed, 39 insertions, 40 deletions
diff --git a/Utility/Format.hs b/Utility/Format.hs
index c0ba46580..2c2042cc2 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -15,11 +15,10 @@ module Utility.Format (
) where
import Text.Printf (printf)
-import Data.Char (isAlphaNum, isOctDigit, chr, ord)
+import Data.Char (isAlphaNum, isOctDigit, isSpace, chr, ord)
import Data.Maybe (fromMaybe)
import Data.Word (Word8)
import Data.List (isPrefixOf)
-import Data.String.Utils (replace)
import qualified Codec.Binary.UTF8.String
import qualified Data.Map as M
@@ -30,13 +29,13 @@ type FormatString = 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
+{- A fragment is either a constant string,
+ - or a variable, with a justification. -}
+data Frag = Const String | Var String Justify
deriving (Show)
-{- Positive padding is right justification; negative padding is left
- - justification. -}
-type Padding = Int
+data Justify = LeftJustified Int | RightJustified Int | UnJustified
+ deriving (Show)
{- Expands a Format using some variables, generating a formatted string.
- This can be repeatedly called, efficiently. -}
@@ -44,20 +43,16 @@ format :: Format -> M.Map String String -> String
format f vars = concatMap expand f
where
expand (Const s) = s
- expand (Var name padding) = justify padding $ getvar name
- getvar name
- | "escaped_" `isPrefixOf` name =
- -- escape whitespace too
- replace " " (e_asc ' ') $
- replace "\t" (e_asc '\t') $
- encode_c $
- getvar' $ drop (length "escaped_") name
- | otherwise = getvar' name
- getvar' name = 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
+ 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
@@ -82,17 +77,20 @@ gen = filter (not . empty) . fuse [] . scan [] . decode_c
invar f var [] = Const (novar var) : f
invar f var (c:cs)
- | c == '}' = foundvar f var 0 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 (readpad $ reverse p) 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
- readpad = fromMaybe 0 . readMaybe
-
+ readjustify = getjustify . fromMaybe 0 . readMaybe
+ getjustify i
+ | i == 0 = UnJustified
+ | i < 0 = LeftJustified (-1 * i)
+ | otherwise = RightJustified i
novar v = "${" ++ reverse v
foundvar f v p cs = scan (Var (reverse v) p : f) cs
@@ -139,7 +137,14 @@ decode_c s = unescape ("", s)
{- Inverse of decode_c. -}
encode_c :: FormatString -> FormatString
-encode_c s = concatMap echar s
+encode_c = encode_c' (const False)
+
+{- Encodes more strictly, including whitespace. -}
+encode_c_strict :: FormatString -> FormatString
+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'
@@ -153,21 +158,15 @@ encode_c s = concatMap echar s
echar '"' = e '"'
echar c
| ord c < 0x20 = e_asc c -- low ascii
- | ord c >= 256 = e_utf c
+ | ord c >= 256 = e_utf c -- unicode
| ord c > 0x7E = e_asc c -- high ascii
- | otherwise = [c] -- printable ascii
-
--- unicode character is decomposed to individual Word8s,
--- and each is shown in octal
-e_utf :: Char -> String
-e_utf c = showoctal . toInteger =<<
- (Codec.Binary.UTF8.String.encode [c] :: [Word8])
-
-e_asc :: Char -> String
-e_asc c = showoctal $ toInteger $ ord c
-
-showoctal :: Integer -> String
-showoctal i = '\\' : printf "%03o" i
+ | 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