{-|
This module contains the preprocessor parser, which splits a command into a list of `String`s - one `String` per block.
-}
module Lsql.Csv.Lang.BlockSeparator (splitBlocks) where

import Text.Parsec
import Text.Parsec.Prim
import Text.Parsec.Combinator
import Text.Parsec.Text
import Text.Parsec.Char

import Data.List
import qualified Data.Text as T

quote1 :: Parser String
quote1 :: Parser String
quote1 = do
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  String
ret <- ParsecT Text () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(ParsecT Text () Identity Char -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\""
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

quote2 :: Parser String
quote2 :: Parser String
quote2 = do
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  String
ret <- ParsecT Text () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(ParsecT Text () Identity Char -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"'"
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

quote3 :: Parser String
quote3 :: Parser String
quote3 = do
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'
  String
ret <- ParsecT Text () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(ParsecT Text () Identity Char -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"`"
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'
  String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"

quote4 :: Parser String
quote4 :: Parser String
quote4 = do
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  String
ret <- ParsecT Text () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(ParsecT Text () Identity Char -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"}"
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
  String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"


normal :: Parser String
normal :: Parser String
normal = ParsecT Text () Identity Char -> Parser 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 -> Parser String)
-> ParsecT Text () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"`',{"

block :: Parser String
block :: Parser String
block = do
  [String]
cret <- Parser String -> 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(Parser String -> ParsecT Text () Identity [String])
-> Parser String -> ParsecT Text () Identity [String]
forall a b. (a -> b) -> a -> b
$ (Parser String
quote1 Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
quote2 Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
quote3 Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
quote4 Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
normal)
  String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
cret

nonTerminalBlock :: Parser String
nonTerminalBlock :: Parser String
nonTerminalBlock = do
  String
ret <- Parser String
block
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  String -> Parser String
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
ret

blocks :: Parser [String]
blocks :: ParsecT Text () Identity [String]
blocks = do
  [String]
rets <- Parser String -> ParsecT Text () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(Parser String -> ParsecT Text () Identity [String])
-> Parser String -> ParsecT Text () Identity [String]
forall a b. (a -> b) -> a -> b
$ Parser String -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser String
nonTerminalBlock
  String
last <- Parser String
block
  [String] -> ParsecT Text () Identity [String]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return([String] -> ParsecT Text () Identity [String])
-> [String] -> ParsecT Text () Identity [String]
forall a b. (a -> b) -> a -> b
$ [String]
rets [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
last]
  
-- | The preprocessor parser function, which splits command into a list of `String`s - one `String` per block.
splitBlocks :: String -> [String]
splitBlocks :: String -> [String]
splitBlocks String
input =
  case ParsecT Text () Identity [String]
-> String -> Text -> Either ParseError [String]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse ParsecT Text () Identity [String]
blocks String
"block parser"(Text -> Either ParseError [String])
-> Text -> Either ParseError [String]
forall a b. (a -> b) -> a -> b
$ (String -> Text
T.pack String
input) of
    Left ParseError
err -> String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
    Right [String]
val -> [String]
val