module Util.CommandStringSub(
CompiledFormatString,
compileFormatString,
runFormatString,
doFormatString,
emacsEscape,
bashEscape,
) where
import Data.Char
import Util.Computation
data FormatItem =
Unescaped String
| Escaped (String -> String) Char
newtype CompiledFormatString = CompiledFormatString [FormatItem]
compileFormatString :: String -> WithError CompiledFormatString
compileFormatString str =
case splitToDollar str of
Nothing -> hasValue (prependLiteral str (CompiledFormatString []))
Just (s1,s2) ->
mapWithError'
(\ (ch,transformer,withError) ->
mapWithError
(\ (CompiledFormatString l) ->
prependLiteral s1
(CompiledFormatString ((Escaped transformer ch):l))
)
withError
)
(compileFromEscape s2)
splitToDollar :: String -> Maybe (String,String)
splitToDollar "" = Nothing
splitToDollar ('%':rest) = Just ("",rest)
splitToDollar (c:rest) = fmap (\ (s1,s2) -> (c:s1,s2)) (splitToDollar rest)
prependLiteral :: String -> CompiledFormatString -> CompiledFormatString
prependLiteral "" compiledFormatString = compiledFormatString
prependLiteral s (CompiledFormatString l) =
CompiledFormatString (Unescaped s:l)
compileFromEscape :: String
-> WithError (Char,String -> String,WithError CompiledFormatString)
compileFromEscape "" = hasError "Format string ends unexpectedly"
compileFromEscape (c:rest) =
if isUpper c || c == '%' then hasValue (c,id,compileFormatString rest)
else case c of
'e' -> mapEscapeFunction emacsEscape rest
'b' -> mapEscapeFunction bashEscape rest
_ ->
let
compiledRest = compileFormatString rest
e = error "Attempt to run bad format string"
restFaked = hasValue (e,e,compiledRest)
message = if isLower c then
"Transformer character " ++ [c] ++ " not recognised."
else "Unexpected character "++ show c ++ " in format string."
in
mapWithError snd (pairWithError (hasError message) restFaked)
mapEscapeFunction :: (String -> String) -> String ->
WithError (Char,String -> String,WithError CompiledFormatString)
mapEscapeFunction escapeFunction s =
mapWithError
(\ (ch,transformer,rest) -> (ch,escapeFunction . transformer,rest))
(compileFromEscape s)
mkEscapeFunction :: (Char -> String) -> (String -> String)
mkEscapeFunction chEscape str =
concat (map chEscape str)
bashEscape :: String -> String
bashEscape = mkEscapeFunction chbashEscape
chbashEscape :: Char -> String
chbashEscape ch =
case ch of
'\\' -> "\\\\"
'\"' -> "\\\""
'$' -> "\\$"
'`' -> "\\`"
_ -> [ch]
emacsEscape :: String -> String
emacsEscape = mkEscapeFunction chEmacsEscape
chEmacsEscape :: Char -> String
chEmacsEscape ch =
case ch of
'\n' -> "\\n"
'\t' -> "\\t"
'\r' -> "\\r"
'\f' -> "\\f"
'\b' -> "\\b"
'\\' -> "\\\\"
'\"' -> "\\\""
ch -> if isPrint ch then [ch] else "\\"++to3Oct ch
where
to3Oct :: Char -> String
to3Oct ch =
let
chOct = toOctal ch
in
case chOct of
"" -> "000"
[_] -> "00"++chOct
[_,_] -> "0" ++ chOct
[_,_,_] -> chOct
_ -> error
"Character with enormous character code can't be emacs-escaped"
toOctal :: Char -> String
toOctal ch =
let
toOct :: Int -> String
toOct i =
let
(q,r) = divMod i 8
e = [intToDigit r]
in
if q==0 then e else toOct q++e
in
toOct (ord ch)
runFormatString :: CompiledFormatString -> (Char -> Maybe String)
-> WithError String
runFormatString (CompiledFormatString l) lookup =
let
withErrors =
map
(\ formatItem -> case formatItem of
Unescaped str -> hasValue str
Escaped transformer '%' -> hasValue "%"
Escaped transformer ch -> case lookup ch of
Nothing -> hasError ("%"++[ch]++" not defined")
Just str -> hasValue (transformer str)
)
l
appendWithError we1 we2 = mapWithError (uncurry (++))
(pairWithError we1 we2)
in
foldr appendWithError (hasValue "") withErrors
doFormatString :: String -> (Char -> Maybe String) -> String
doFormatString format lookup =
let
we1 = compileFormatString format
we2 = mapWithError'
(\ compiled -> runFormatString compiled lookup)
we1
in
coerceWithError we2