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]
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