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