{-# LANGUAGE OverloadedStrings #-}
module Text.CurlyExpander
(
curlyExpand,
BackslashConfig (NoHandle, Preserve, Standard),
ExpandConfig (ExpandConfig, quotePairs, backslashConfig, persistQuotePairs, allowOneElementExpand),
defaultExpandConfig,
customCurlyExpand
)
where
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder (toLazyText)
import Text.Parsec
import Text.Parsec.Text
import Data.Char
data BackslashConfig =
NoHandle |
Preserve |
Standard
deriving BackslashConfig -> BackslashConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackslashConfig -> BackslashConfig -> Bool
$c/= :: BackslashConfig -> BackslashConfig -> Bool
== :: BackslashConfig -> BackslashConfig -> Bool
$c== :: BackslashConfig -> BackslashConfig -> Bool
Eq
data ExpandConfig = ExpandConfig {
ExpandConfig -> BackslashConfig
backslashConfig :: BackslashConfig,
ExpandConfig -> [(String, String)]
quotePairs :: [(String, String)],
ExpandConfig -> Bool
persistQuotePairs :: Bool,
ExpandConfig -> Bool
allowOneElementExpand :: Bool
}
defaultExpandConfig :: ExpandConfig
defaultExpandConfig :: ExpandConfig
defaultExpandConfig = ExpandConfig {
backslashConfig :: BackslashConfig
backslashConfig = BackslashConfig
NoHandle,
quotePairs :: [(String, String)]
quotePairs = [],
persistQuotePairs :: Bool
persistQuotePairs = Bool
False,
allowOneElementExpand :: Bool
allowOneElementExpand = Bool
False
}
customCurlyExpand :: ExpandConfig -> T.Text -> [T.Text]
customCurlyExpand :: ExpandConfig -> Text -> [Text]
customCurlyExpand ExpandConfig
config Text
input =
case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [Text]
inputP String
"bracket expansion"forall a b. (a -> b) -> a -> b
$ Text
input of
Left ParseError
_ -> [Text
input]
Right [Text]
ret -> forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.toStrict [Text]
ret
where
cumulatorComma :: Parser [L.Text]
cumulatorComma :: Parser [Text]
cumulatorComma = do
[Text]
atoms <- (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_range) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_char_range) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Text]
p_atoms
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
atoms
where
p_range :: Parser [L.Text]
p_range :: Parser [Text]
p_range = do
String
nb1 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".."
String
nb2 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Builder
decimal) forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
get_range (forall a. Read a => String -> a
read String
nb1) (forall a. Read a => String -> a
read String
nb2)
where
get_range :: Int -> Int -> [Int]
get_range :: Int -> Int -> [Int]
get_range Int
n1 Int
n2
| Int
n1 forall a. Ord a => a -> a -> Bool
> Int
n2 = forall a. [a] -> [a]
reverseforall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
get_range Int
n2 Int
n1
| Bool
otherwise = [Int
n1..Int
n2]
p_char_range :: Parser [L.Text]
p_char_range :: Parser [Text]
p_char_range = do
Char
char1 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".."
Char
char2 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> Text
L.pack [Char
p] | Char
p <- Char -> Char -> String
get_range Char
char1 Char
char2 ]
where
get_range :: Char -> Char -> [Char]
get_range :: Char -> Char -> String
get_range Char
c1 Char
c2
| Int
n1 forall a. Ord a => a -> a -> Bool
> Int
n2 = forall a. [a] -> [a]
reverseforall a b. (a -> b) -> a -> b
$ Char -> Char -> String
get_range Char
c2 Char
c1
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
n1..Int
n2]
where
n1 :: Int
n1 = Char -> Int
ord Char
c1
n2 :: Int
n2 = Char -> Int
ord Char
c2
p_atoms :: Parser [L.Text]
p_atoms :: Parser [Text]
p_atoms = do
[[Text]]
molecule <- Parser [[Text]]
moleculeP
[Text]
terminal_atom <- Parser [Text]
innerInputP
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]]
molecule) forall a. [a] -> [a] -> [a]
++ [Text]
terminal_atom
where
moleculeP :: Parser [[L.Text]]
moleculeP :: Parser [[Text]]
moleculeP =
if ExpandConfig -> Bool
allowOneElementExpand ExpandConfig
config; then
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_atom)
else
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_atom)
p_atom :: Parser [L.Text]
p_atom :: Parser [Text]
p_atom = do
[Text]
atom <- Parser [Text]
innerInputP
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
atom
bracketP :: Parser [L.Text]
bracketP :: Parser [Text]
bracketP = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
[Text]
ret <- Parser [Text]
cumulatorComma
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$ [Text]
ret
charP :: Parser [L.Text]
charP :: Parser [Text]
charP = do
Char
c <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Text
L.pack [Char
c]]
nonSpecialCharP :: Parser [L.Text]
nonSpecialCharP :: Parser [Text]
nonSpecialCharP = do
Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
",}"
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Text
L.pack [Char
c]]
backslashedP :: Parser [L.Text]
backslashedP :: Parser [Text]
backslashedP = do
if Bool
handleBackslash then do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
Char
c <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$ Char -> [Text]
getReturnValue Char
c
else do
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"Char is not backslashed."
where
handleBackslash :: Bool
handleBackslash :: Bool
handleBackslash =
if ExpandConfig -> BackslashConfig
backslashConfig ExpandConfig
config forall a. Eq a => a -> a -> Bool
== BackslashConfig
NoHandle then
Bool
False
else
Bool
True
getReturnValue :: Char -> [L.Text]
getReturnValue :: Char -> [Text]
getReturnValue Char
c =
if ExpandConfig -> BackslashConfig
backslashConfig ExpandConfig
config forall a. Eq a => a -> a -> Bool
== BackslashConfig
Preserve then
[ String -> Text
L.pack [Char
'\\', Char
c] ]
else
[ String -> Text
L.pack [Char
c] ]
specialQuotedP :: (String, String) -> Parser [L.Text]
specialQuotedP :: (String, String) -> Parser [Text]
specialQuotedP (String
lQuote,String
rQuote) = do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
lQuote
Text
ret <- Parser Text
quoteNext
forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$ [Text -> Text
enrichReturnValue Text
ret]
where
quoteClosure :: Parser L.Text
quoteClosure :: Parser Text
quoteClosure = do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
rQuote
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
quoteNextChar :: Parser L.Text
quoteNextChar :: Parser Text
quoteNextChar = do
Char
c <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
Text
rest <- Parser Text
quoteNext
forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$ String -> Text
L.pack [Char
c] Text -> Text -> Text
`L.append` Text
rest
quoteNext :: Parser L.Text
quoteNext :: Parser Text
quoteNext = (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Text
quoteClosure forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Text
quoteNextChar)
enrichReturnValue :: L.Text -> L.Text
enrichReturnValue :: Text -> Text
enrichReturnValue Text
ret =
if ExpandConfig -> Bool
persistQuotePairs ExpandConfig
config; then
(String -> Text
L.pack String
lQuote) Text -> Text -> Text
`L.append` Text
ret Text -> Text -> Text
`L.append` (String -> Text
L.pack String
rQuote)
else
Text
ret
quotedP :: [(String, String)] -> Parser [L.Text]
quotedP :: [(String, String)] -> Parser [Text]
quotedP ((String, String)
quotes : [(String, String)]
rest) = (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
tryforall a b. (a -> b) -> a -> b
$ (String, String) -> Parser [Text]
specialQuotedP (String, String)
quotes) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [(String, String)] -> Parser [Text]
quotedP [(String, String)]
rest
quotedP [] = forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"String is not quoted."
allQuotedP :: Parser [L.Text]
allQuotedP :: Parser [Text]
allQuotedP = [(String, String)] -> Parser [Text]
quotedPforall a b. (a -> b) -> a -> b
$ ExpandConfig -> [(String, String)]
quotePairs ExpandConfig
config
innerNonEmptyInputP :: Parser [L.Text]
innerNonEmptyInputP :: Parser [Text]
innerNonEmptyInputP = do
[Text]
molecule <- (Parser [Text]
backslashedP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
allQuotedP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
bracketP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Text]
nonSpecialCharP)
[Text]
rest <- Parser [Text]
innerInputP
forall (m :: * -> *) a. Monad m => a -> m a
return [ Text -> Text -> Text
L.append Text
a Text
b | Text
a <- [Text]
molecule, Text
b <- [Text]
rest ]
innerInputP :: Parser [L.Text]
innerInputP :: Parser [Text]
innerInputP = (Parser [Text]
innerNonEmptyInputP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Text]
emptyInputP)
nonEmptyInputP :: Parser [L.Text]
nonEmptyInputP :: Parser [Text]
nonEmptyInputP = do
[Text]
molecule <- (Parser [Text]
backslashedP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
allQuotedP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
bracketP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Text]
charP)
[Text]
rest <- Parser [Text]
inputP
forall (m :: * -> *) a. Monad m => a -> m a
return [ Text -> Text -> Text
L.append Text
a Text
b | Text
a <- [Text]
molecule, Text
b <- [Text]
rest ]
emptyInputP :: Parser [L.Text]
emptyInputP :: Parser [Text]
emptyInputP = do
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
""]
inputP :: Parser [L.Text]
inputP :: Parser [Text]
inputP = (Parser [Text]
nonEmptyInputP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Text]
emptyInputP)
curlyExpand :: T.Text -> [T.Text]
curlyExpand :: Text -> [Text]
curlyExpand Text
input =
ExpandConfig -> Text -> [Text]
customCurlyExpand ExpandConfig
defaultExpandConfig Text
input