{-|
Module      : Text.CurlyExpander
License     : LGPL-3
Maintainer  : p-w@stty.cz
Stability   : testing
Portability : POSIX

This is the main module of the curly-expander package.

-}

{-# 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)
  

-- | Curly braces (brackets) expand function
--
-- First argument is a `Data.Text`, which you want to expand. Second argument is a list of expanded `Data.Text`s.
--
-- There are given few usage examples:
--
-- >>> curlyExpand "car{A,B}"
-- ["carA","carB"]
--
-- >>> curlyExpand "car{1..5}"
-- ["car1","car2","car3","car4","car5"]
--
-- >>> curlyExpand "car{{A,B},{C,D}}"
-- ["carA", "carB", "carC", "carD"]
--
-- >>> curlyExpand "{car,bus}{A..C}"
-- ["carA", "carB", "carC", "busA", "busB", "busC"]
--
-- Be aware, that these examples will run only with `OverloadedStrings` language extension and proper `Data.Text` imports.

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