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

This is the main (and only) module of the curly-expander package.

-}

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

-- | This configuration specify, how should be backslashes handled.
-- It is part of `ExpandConfig`.
data BackslashConfig = 
    -- | If no handle is used, then backslashes are not handled in any special way.
    NoHandle | 

    -- | If preserve is used, backslashes are processed, any backslashed char is processed as nonspecial char 
    -- and backslashes aren't deleted from result.
    Preserve | 

    -- | If standard is used, backslashes are processed, any backslashed char is processed as nonspecial char
    -- and backslashes are deleted from result.
    Standard
  deriving BackslashConfig -> BackslashConfig -> Bool
(BackslashConfig -> BackslashConfig -> Bool)
-> (BackslashConfig -> BackslashConfig -> Bool)
-> Eq BackslashConfig
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


-- | The curly braces expand config. 
-- It is used in `customCurlyExpand`.
data ExpandConfig = ExpandConfig {
    -- | The configuration, which defines, how should be backslashes handled (\\)
    ExpandConfig -> BackslashConfig
backslashConfig :: BackslashConfig,

    -- | Quote pairs, which encloses a substrings, tells expander, that the substring shouldn't be expanded.
    -- For example (\"[\", \"]\") pairs tells to expander, that anything inside [ANYTHING] shouldn't be expanded.
    ExpandConfig -> [(String, String)]
quotePairs :: [(String, String)],

    -- | If true, quote pairs aren't deleted. Otherwise they are deleted from a result.
    ExpandConfig -> Bool
persistQuotePairs :: Bool,

    -- | If true, curly brackets around one element will be deleted. Otherwise they are persisted.
    ExpandConfig -> Bool
allowOneElementExpand :: Bool
  }


-- | The default curly braces expand function config.
-- By default backslashes are not handeled, there are no quote pairs and one element expand is forbidden.
-- See the source code for details.
defaultExpandConfig :: ExpandConfig
defaultExpandConfig :: ExpandConfig
defaultExpandConfig = ExpandConfig :: BackslashConfig
-> [(String, String)] -> Bool -> Bool -> ExpandConfig
ExpandConfig { 
    backslashConfig :: BackslashConfig
backslashConfig = BackslashConfig
NoHandle, 
    quotePairs :: [(String, String)]
quotePairs = [],
    persistQuotePairs :: Bool
persistQuotePairs = Bool
False,
    allowOneElementExpand :: Bool
allowOneElementExpand = Bool
False
  }

-- | Custom curly braces (brackets) expand function.
-- It works in the same way as curlyExpand, bud accept custom configuration `ExpandConfig` in the first argument.

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 (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 (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
          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 (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] -> Parsec Text () [Text]
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 (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 (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 (m :: * -> *) t u a.
Stream s m t =>
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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)

-- | 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 =
  ExpandConfig -> Text -> [Text]
customCurlyExpand ExpandConfig
defaultExpandConfig Text
input