{-# 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
(BackslashConfig -> BackslashConfig -> Bool)
-> (BackslashConfig -> BackslashConfig -> Bool)
-> Eq BackslashConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackslashConfig -> BackslashConfig -> Bool
== :: BackslashConfig -> BackslashConfig -> Bool
$c/= :: BackslashConfig -> BackslashConfig -> Bool
/= :: 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 Parsec Text () [Text] -> String -> Text -> Either ParseError [Text]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () [Text]
inputP String
"bracket expansion"(Text -> Either ParseError [Text])
-> Text -> Either ParseError [Text]
forall a b. (a -> b) -> a -> b
$ Text
input of
Left ParseError
_ -> [Text
input]
Right [Text]
ret -> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.toStrict [Text]
ret
where
cumulatorComma :: Parser [L.Text]
cumulatorComma :: Parsec Text () [Text]
cumulatorComma = do
[Text]
atoms <- (Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
p_range) Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
p_char_range) Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text]
p_atoms
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
atoms
where
p_range :: Parser [L.Text]
p_range :: Parsec Text () [Text]
p_range = do
String
nb1 <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".."
String
nb2 <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return([Text] -> Parsec Text () [Text])
-> [Text] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text
toLazyText (Builder -> Text) -> (Int -> Builder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. Integral a => a -> Builder
decimal) ([Int] -> [Text]) -> [Int] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
get_range (String -> Int
forall a. Read a => String -> a
read String
nb1) (String -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2 = [Int] -> [Int]
forall a. [a] -> [a]
reverse([Int] -> [Int]) -> [Int] -> [Int]
forall 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 :: Parsec Text () [Text]
p_char_range = do
Char
char1 <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".."
Char
char2 <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2 = String -> String
forall a. [a] -> [a]
reverse(String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> Char -> String
get_range Char
c2 Char
c1
| Bool
otherwise = (Int -> Char) -> [Int] -> String
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 :: Parsec Text () [Text]
p_atoms = do
[[Text]]
molecule <- Parser [[Text]]
moleculeP
[Text]
terminal_atom <- Parsec Text () [Text]
innerInputP
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Parsec Text () [Text])
-> [Text] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ ([[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]]
molecule) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
terminal_atom
where
moleculeP :: Parser [[L.Text]]
moleculeP :: Parser [[Text]]
moleculeP =
if ExpandConfig -> Bool
allowOneElementExpand ExpandConfig
config; then
Parsec Text () [Text] -> Parser [[Text]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
p_atom)
else
Parsec Text () [Text] -> Parser [[Text]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
p_atom)
p_atom :: Parser [L.Text]
p_atom :: Parsec Text () [Text]
p_atom = do
[Text]
atom <- Parsec Text () [Text]
innerInputP
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
atom
bracketP :: Parser [L.Text]
bracketP :: Parsec Text () [Text]
bracketP = do
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
[Text]
ret <- Parsec Text () [Text]
cumulatorComma
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return([Text] -> Parsec Text () [Text])
-> [Text] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
ret
charP :: Parser [L.Text]
charP :: Parsec Text () [Text]
charP = do
Char
c <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Text
L.pack [Char
c]]
nonSpecialCharP :: Parser [L.Text]
nonSpecialCharP :: Parsec Text () [Text]
nonSpecialCharP = do
Char
c <- String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
",}"
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Text
L.pack [Char
c]]
backslashedP :: Parser [L.Text]
backslashedP :: Parsec Text () [Text]
backslashedP = do
if Bool
handleBackslash then do
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
Char
c <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return([Text] -> Parsec Text () [Text])
-> [Text] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ Char -> [Text]
getReturnValue Char
c
else do
String -> Parsec Text () [Text]
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 BackslashConfig -> BackslashConfig -> Bool
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 BackslashConfig -> BackslashConfig -> Bool
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) -> Parsec Text () [Text]
specialQuotedP (String
lQuote,String
rQuote) = do
String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
lQuote
Text
ret <- Parser Text
quoteNext
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return([Text] -> Parsec Text () [Text])
-> [Text] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ [Text -> Text
enrichReturnValue Text
ret]
where
quoteClosure :: Parser L.Text
quoteClosure :: Parser Text
quoteClosure = do
String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
rQuote
Text -> Parser Text
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
quoteNextChar :: Parser L.Text
quoteNextChar :: Parser Text
quoteNextChar = do
Char
c <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
Text
rest <- Parser Text
quoteNext
Text -> Parser Text
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(Text -> Parser Text) -> Text -> Parser Text
forall 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 = (Parser Text -> Parser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Text
quoteClosure Parser Text -> Parser Text -> Parser Text
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)] -> Parsec Text () [Text]
quotedP ((String, String)
quotes : [(String, String)]
rest) = (Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try(Parsec Text () [Text] -> Parsec Text () [Text])
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ (String, String) -> Parsec Text () [Text]
specialQuotedP (String, String)
quotes) Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [(String, String)] -> Parsec Text () [Text]
quotedP [(String, String)]
rest
quotedP [] = String -> Parsec Text () [Text]
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 :: Parsec Text () [Text]
allQuotedP = [(String, String)] -> Parsec Text () [Text]
quotedP([(String, String)] -> Parsec Text () [Text])
-> [(String, String)] -> Parsec Text () [Text]
forall a b. (a -> b) -> a -> b
$ ExpandConfig -> [(String, String)]
quotePairs ExpandConfig
config
innerNonEmptyInputP :: Parser [L.Text]
innerNonEmptyInputP :: Parsec Text () [Text]
innerNonEmptyInputP = do
[Text]
molecule <- (Parsec Text () [Text]
backslashedP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
allQuotedP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
bracketP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text]
nonSpecialCharP)
[Text]
rest <- Parsec Text () [Text]
innerInputP
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
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 :: Parsec Text () [Text]
innerInputP = (Parsec Text () [Text]
innerNonEmptyInputP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text]
emptyInputP)
nonEmptyInputP :: Parser [L.Text]
nonEmptyInputP :: Parsec Text () [Text]
nonEmptyInputP = do
[Text]
molecule <- (Parsec Text () [Text]
backslashedP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
allQuotedP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () [Text]
bracketP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text]
charP)
[Text]
rest <- Parsec Text () [Text]
inputP
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
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 :: Parsec Text () [Text]
emptyInputP = do
[Text] -> Parsec Text () [Text]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
""]
inputP :: Parser [L.Text]
inputP :: Parsec Text () [Text]
inputP = (Parsec Text () [Text]
nonEmptyInputP Parsec Text () [Text]
-> Parsec Text () [Text] -> Parsec Text () [Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () [Text]
emptyInputP)
curlyExpand :: T.Text -> [T.Text]
curlyExpand :: Text -> [Text]
curlyExpand Text
input =
ExpandConfig -> Text -> [Text]
customCurlyExpand ExpandConfig
defaultExpandConfig Text
input