{-# LANGUAGE OverloadedStrings #-}
module Text.CurlyExpander (curlyExpand) 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
cumulatorComma :: Parser [L.Text]
cumulatorComma :: Parser [Text]
cumulatorComma = do
[Text]
atoms <- (Parser [Text] -> Parser [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_range) 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] -> Parser [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_char_range) 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]
p_atoms
[Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
atoms
where
p_range :: Parser [L.Text]
p_range :: Parser [Text]
p_range = do
[Char]
nb1 <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
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
[Char]
_ <- [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
[Char]
nb2 <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
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] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return([Text] -> Parser [Text]) -> [Text] -> Parser [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 ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
nb1) ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
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 :: Parser [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
[Char]
_ <- [Char] -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".."
Char
char2 <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [ [Char] -> Text
L.pack [Char
p] | Char
p <- Char -> Char -> [Char]
get_range Char
char1 Char
char2 ]
where
get_range :: Char -> Char -> [Char]
get_range :: Char -> Char -> [Char]
get_range Char
c1 Char
c2
| Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2 = [Char] -> [Char]
forall a. [a] -> [a]
reverse([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> [Char]
get_range Char
c2 Char
c1
| Bool
otherwise = (Int -> Char) -> [Int] -> [Char]
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] -> ParsecT Text () Identity [[Text]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1(Parser [Text] -> ParsecT Text () Identity [[Text]])
-> Parser [Text] -> ParsecT Text () Identity [[Text]]
forall a b. (a -> b) -> a -> b
$ Parser [Text] -> Parser [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
p_atom
[Text]
terminal_atom <- Parser [Text]
innerInputP
[Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Parser [Text]) -> [Text] -> Parser [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
p_atom :: Parser [L.Text]
p_atom :: Parser [Text]
p_atom = do
[Text]
atom <- Parser [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] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
atom
bracketP :: Parser [L.Text]
bracketP :: Parser [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 <- Parser [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] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return([Text] -> Parser [Text]) -> [Text] -> Parser [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
ret
charP :: Parser [L.Text]
charP :: Parser [Text]
charP = do
Char
c <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Text
L.pack [Char
c]]
nonSpecialCharP :: Parser [L.Text]
nonSpecialCharP :: Parser [Text]
nonSpecialCharP = do
Char
c <- [Char] -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
",}"
[Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Text
L.pack [Char
c]]
innerNonEmptyInputP :: Parser [L.Text]
innerNonEmptyInputP :: Parser [Text]
innerNonEmptyInputP = do
[Text]
molecule <- (Parser [Text] -> Parser [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
bracketP 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]
nonSpecialCharP)
[Text]
rest <- Parser [Text]
innerInputP
[Text] -> Parser [Text]
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 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]
emptyInputP)
nonEmptyInputP :: Parser [L.Text]
nonEmptyInputP :: Parser [Text]
nonEmptyInputP = do
[Text]
molecule <- (Parser [Text] -> Parser [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [Text]
bracketP 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]
charP)
[Text]
rest <- Parser [Text]
inputP
[Text] -> Parser [Text]
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
[Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
""]
inputP :: Parser [L.Text]
inputP :: Parser [Text]
inputP = (Parser [Text]
nonEmptyInputP 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]
emptyInputP)
curlyExpand :: T.Text -> [T.Text]
curlyExpand :: Text -> [Text]
curlyExpand Text
input =
case Parser [Text] -> [Char] -> Text -> Either ParseError [Text]
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parser [Text]
inputP [Char]
"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