module ProjectM36.Relation.Parse.CSV where
--parse Relations from CSV
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.Relation
import ProjectM36.AtomType
import ProjectM36.DataTypes.Interval
import qualified ProjectM36.Attribute as A

import Data.Csv.Parser
import qualified Data.Vector as V
import Data.Char (ord, isUpper, isSpace)
import qualified Data.ByteString.Lazy as BS
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Set as S
import qualified Data.HashMap.Lazy as HM
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Attoparsec.ByteString.Lazy as APBL
import qualified Data.Attoparsec.Text as APT
import Control.Arrow
import Text.Read hiding (parens)
import Control.Applicative
import Data.Either
import Control.Monad (void)

data CsvImportError = CsvParseError String |
                      AttributeMappingError RelationalError |
                      HeaderAttributeMismatchError (S.Set AttributeName)
                    deriving (Int -> CsvImportError -> ShowS
[CsvImportError] -> ShowS
CsvImportError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CsvImportError] -> ShowS
$cshowList :: [CsvImportError] -> ShowS
show :: CsvImportError -> [Char]
$cshow :: CsvImportError -> [Char]
showsPrec :: Int -> CsvImportError -> ShowS
$cshowsPrec :: Int -> CsvImportError -> ShowS
Show)

csvDecodeOptions :: DecodeOptions
csvDecodeOptions :: DecodeOptions
csvDecodeOptions = DecodeOptions {decDelimiter :: Word8
decDelimiter = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
',')}

csvAsRelation :: Attributes -> TypeConstructorMapping -> BS.ByteString -> Either CsvImportError Relation
csvAsRelation :: Attributes
-> TypeConstructorMapping
-> ByteString
-> Either CsvImportError Relation
csvAsRelation Attributes
attrs TypeConstructorMapping
tConsMap ByteString
inString = case forall a. Parser a -> ByteString -> Result a
APBL.parse (DecodeOptions -> Parser (Header, Vector NamedRecord)
csvWithHeader DecodeOptions
csvDecodeOptions) ByteString
inString of
  APBL.Fail ByteString
_ [[Char]]
_ [Char]
err -> forall a b. a -> Either a b
Left ([Char] -> CsvImportError
CsvParseError [Char]
err)
  APBL.Done ByteString
_ (Header
headerRaw,Vector NamedRecord
vecMapsRaw) -> do
    let strHeader :: Vector Text
strHeader = forall a b. (a -> b) -> Vector a -> Vector b
V.map ByteString -> Text
decodeUtf8 Header
headerRaw
        strMapRecords :: Vector (HashMap Text [Char])
strMapRecords = forall a b. (a -> b) -> Vector a -> Vector b
V.map NamedRecord -> HashMap Text [Char]
convertMap Vector NamedRecord
vecMapsRaw
        convertMap :: NamedRecord -> HashMap Text [Char]
convertMap NamedRecord
hmap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
L.map (ByteString -> Text
decodeUtf8 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8)) (forall k v. HashMap k v -> [(k, v)]
HM.toList NamedRecord
hmap)
        attrNameSet :: Set Text
attrNameSet = Attributes -> Set Text
A.attributeNameSet Attributes
attrs
        headerSet :: Set Text
headerSet = forall a. Ord a => [a] -> Set a
S.fromList (forall a. Vector a -> [a]
V.toList Vector Text
strHeader)
        parseAtom :: Text -> AtomType -> Text -> Either RelationalError Atom
parseAtom Text
attrName AtomType
aType Text
textIn = case forall a. Parser a -> Text -> Either [Char] a
APT.parseOnly (Text
-> TypeConstructorMapping
-> AtomType
-> Parser Text
-> Parser Text (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
aType Parser Text
takeToEndOfColumnData forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
APT.endOfInput) Text
textIn of
          Left [Char]
err -> forall a b. a -> Either a b
Left (Text -> RelationalError
ParseError ([Char] -> Text
T.pack [Char]
err))
          Right Either RelationalError Atom
eAtom -> Either RelationalError Atom
eAtom 
        makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]
        makeTupleList :: HashMap Text [Char] -> [Either CsvImportError Atom]
makeTupleList HashMap Text [Char]
tupMap = forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Attribute
attr -> 
                                                  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalError -> CsvImportError
AttributeMappingError) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 
                                                  Text -> AtomType -> Text -> Either RelationalError Atom
parseAtom (Attribute -> Text
A.attributeName Attribute
attr) (Attribute -> AtomType
A.atomType Attribute
attr) ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ HashMap Text [Char]
tupMap forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Attribute -> Text
A.attributeName Attribute
attr)) (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
    if Set Text
attrNameSet forall a. Eq a => a -> a -> Bool
== Set Text
headerSet then do
      [[Atom]]
tupleList <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList (forall a b. (a -> b) -> Vector a -> Vector b
V.map HashMap Text [Char] -> [Either CsvImportError Atom]
makeTupleList Vector (HashMap Text [Char])
strMapRecords)
      case Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
tupleList of
        Left RelationalError
err -> forall a b. a -> Either a b
Left (RelationalError -> CsvImportError
AttributeMappingError RelationalError
err)
        Right Relation
rel -> forall a b. b -> Either a b
Right Relation
rel
      else
      forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Set Text -> CsvImportError
HeaderAttributeMismatchError (forall a. Ord a => Set a -> Set a -> Set a
S.difference Set Text
attrNameSet Set Text
headerSet)


parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> APT.Parser T.Text -> APT.Parser (Either RelationalError Atom)
parseCSVAtomP :: Text
-> TypeConstructorMapping
-> AtomType
-> Parser Text
-> Parser Text (Either RelationalError Atom)
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
IntegerAtomType Parser Text
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Atom
IntegerAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
APT.decimal
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
IntAtomType Parser Text
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Atom
IntAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
APT.decimal
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
ScientificAtomType Parser Text
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Atom
ScientificAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Scientific
APT.scientific
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
DoubleAtomType Parser Text
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Atom
DoubleAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
APT.double
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
TextAtomType Parser Text
takeToEndOfData = 
  forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Atom
TextAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
DayAtomType Parser Text
takeToEndOfData = do
  [Char]
dString <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
dString of
    Maybe Day
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid Day string: " forall a. [a] -> [a] -> [a]
++ [Char]
dString)
    Just Day
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Day -> Atom
DayAtom Day
date))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
DateTimeAtomType Parser Text
takeToEndOfData = do    
  [Char]
dString <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
dString of
    Maybe UTCTime
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid Date string: " forall a. [a] -> [a] -> [a]
++ [Char]
dString)
    Just UTCTime
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (UTCTime -> Atom
DateTimeAtom UTCTime
date))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
ByteStringAtomType Parser Text
takeToEndOfData = do    
  [Char]
bsString <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
bsString of
    Maybe ByteString
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid ByteString string: " forall a. [a] -> [a] -> [a]
++ [Char]
bsString)
    Just ByteString
bs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (ByteString -> Atom
ByteStringAtom ByteString
bs))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
BoolAtomType Parser Text
takeToEndOfData = do
  [Char]
bString <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
bString of
    Maybe Bool
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid BoolAtom string: " forall a. [a] -> [a] -> [a]
++ [Char]
bString)
    Just Bool
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Bool -> Atom
BoolAtom Bool
b))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
UUIDAtomType Parser Text
takeToEndOfData = do
  [Char]
uString <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
uString of
    Maybe UUID
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid UUIDAtom string: " forall a. [a] -> [a] -> [a]
++ [Char]
uString)
    Just UUID
u -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (UUID -> Atom
UUIDAtom UUID
u))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
RelationalExprAtomType Parser Text
takeToEndOfData = do
  [Char]
reString <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEndOfData      
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
reString of
    Maybe RelationalExpr
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid RelationalExprAtom string: " forall a. [a] -> [a] -> [a]
++ [Char]
reString)
    Just RelationalExpr
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (RelationalExpr -> Atom
RelationalExprAtom RelationalExpr
b))
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap typ :: AtomType
typ@(ConstructedAtomType Text
_ TypeVarMap
tvmap) Parser Text
takeToEndOfData 
  | AtomType -> Bool
isIntervalAtomType AtomType
typ = do
    Bool
begin <- (Char -> Parser Char
APT.char Char
'[' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
APT.char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
    let iType :: AtomType
iType = AtomType -> AtomType
intervalSubType AtomType
typ
    Either RelationalError Atom
eBeginv <- Text
-> TypeConstructorMapping
-> AtomType
-> Parser Text
-> Parser Text (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
iType Parser Text
takeToEndOfIntervalBlock
    case Either RelationalError Atom
eBeginv of
      Left RelationalError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left RelationalError
err)
      Right Atom
beginv -> do
        Char
_ <- Char -> Parser Char
APT.char Char
','
        Either RelationalError Atom
eEndv <- Text
-> TypeConstructorMapping
-> AtomType
-> Parser Text
-> Parser Text (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
iType Parser Text
takeToEndOfIntervalBlock
        case Either RelationalError Atom
eEndv of
          Left RelationalError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left RelationalError
err)
          Right Atom
endv -> do
            Bool
end <- (Char -> Parser Char
APT.char Char
']' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                   (Char -> Parser Char
APT.char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Text -> AtomType -> [Atom] -> Atom
ConstructedAtom Text
"Interval" AtomType
typ [Atom
beginv, Atom
endv, 
                                                         Bool -> Atom
BoolAtom Bool
begin, Bool -> Atom
BoolAtom Bool
end]))
  | Bool
otherwise = do
    Text
dConsName <- Parser Text
capitalizedIdentifier
    Parser ()
APT.skipSpace
  --we need to look up the name right away in order to determine the types of the following arguments
  -- grab the data constructor
    case Text
-> TypeConstructorMapping
-> Maybe (TypeConstructorDef, DataConstructorDef)
findDataConstructor Text
dConsName TypeConstructorMapping
tConsMap of
      Maybe (TypeConstructorDef, DataConstructorDef)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (Text -> RelationalError
NoSuchDataConstructorError Text
dConsName))
      Just (TypeConstructorDef
_, DataConstructorDef
dConsDef) -> 
      -- identify the data constructor's expected atom type args
        case TypeConstructorMapping
-> TypeVarMap
-> DataConstructorDef
-> Either RelationalError [AtomType]
resolvedAtomTypesForDataConstructorDefArgs TypeConstructorMapping
tConsMap TypeVarMap
tvmap DataConstructorDef
dConsDef of
          Left RelationalError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left RelationalError
err)
          Right [AtomType]
argAtomTypes -> do
            let argMapper :: AtomType -> Parser Text (Either RelationalError Atom)
argMapper AtomType
argTyp = let parseNextAtom :: Parser Text (Either RelationalError Atom)
parseNextAtom = Text
-> TypeConstructorMapping
-> AtomType
-> Parser Text
-> Parser Text (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
argTyp Parser Text
takeToEndOfData forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
APT.skipSpace in
                                      case AtomType
argTyp of
                                        AtomType
TextAtomType -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Atom
TextAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
quotedString forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
APT.skipSpace
                                        ConstructedAtomType Text
_ TypeVarMap
_ -> 
                                          forall a. Parser a -> Parser a
parens Parser Text (Either RelationalError Atom)
parseNextAtom forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                          Parser Text (Either RelationalError Atom)
parseNextAtom
                                        AtomType
_ -> Parser Text (Either RelationalError Atom)
parseNextAtom
            [Either RelationalError Atom]
atomArgs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AtomType -> Parser Text (Either RelationalError Atom)
argMapper [AtomType]
argAtomTypes
            case forall a b. [Either a b] -> [a]
lefts [Either RelationalError Atom]
atomArgs of
              [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Text -> AtomType -> [Atom] -> Atom
ConstructedAtom Text
dConsName AtomType
typ (forall a b. [Either a b] -> [b]
rights [Either RelationalError Atom]
atomArgs)))
              [RelationalError]
errs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ([RelationalError] -> RelationalError
someErrors [RelationalError]
errs))
parseCSVAtomP Text
attrName TypeConstructorMapping
_ (RelationAtomType Attributes
_) Parser Text
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ([Text] -> RelationalError
RelationValuedAttributesNotSupportedError [Text
attrName]))
parseCSVAtomP Text
_ TypeConstructorMapping
_ (TypeVariableType Text
x) Parser Text
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (Text -> RelationalError
TypeConstructorTypeVarMissing Text
x))
      
capitalizedIdentifier :: APT.Parser T.Text
capitalizedIdentifier :: Parser Text
capitalizedIdentifier = do
  Char
fletter <- (Char -> Bool) -> Parser Char
APT.satisfy Char -> Bool
isUpper forall i a. Parser i a -> [Char] -> Parser i a
APT.<?> [Char]
"capitalized data constructor letter"
  Text
rest <- (Char -> Bool) -> Parser Text
APT.takeWhile (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
')')) forall i a. Parser i a -> [Char] -> Parser i a
APT.<?> [Char]
"data constructor name"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
fletter Char -> Text -> Text
`T.cons` Text
rest)
  
takeToEndOfColumnData :: APT.Parser T.Text
takeToEndOfColumnData :: Parser Text
takeToEndOfColumnData = (Char -> Bool) -> Parser Text
APT.takeWhile ([Char] -> Char -> Bool
APT.notInClass [Char]
"")

--read data for Text.Read parser but be wary of end of interval blocks  
takeToEndOfIntervalBlock :: APT.Parser T.Text
takeToEndOfIntervalBlock :: Parser Text
takeToEndOfIntervalBlock = (Char -> Bool) -> Parser Text
APT.takeWhile ([Char] -> Char -> Bool
APT.notInClass [Char]
",)]")
  
parens :: APT.Parser a -> APT.Parser a  
parens :: forall a. Parser a -> Parser a
parens Parser a
p = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
APT.char Char
'('
  Parser ()
APT.skipSpace
  a
v <- Parser a
p
  Parser ()
APT.skipSpace
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
APT.char Char
')'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
  
quotedString :: APT.Parser T.Text
quotedString :: Parser Text
quotedString = do
  let escapeMap :: [(Char, Char)]
escapeMap = [(Char
'"',Char
'"'), (Char
'n', Char
'\n'), (Char
'r', Char
'\r')]
      doubleQuote :: Parser ()
doubleQuote = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
APT.char Char
'"'
  Parser ()
doubleQuote
  (Text
_, [Char]
s) <- forall s. s -> (s -> Char -> Maybe s) -> Parser (Text, s)
APT.runScanner [] (\[Char]
prevl Char
nextChar -> case [Char]
prevl of
                             [] -> forall a. a -> Maybe a
Just [Char
nextChar]
                             [Char]
chars | forall a. [a] -> a
last [Char]
chars forall a. Eq a => a -> a -> Bool
== Char
'\\' ->
                                        case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
nextChar [(Char, Char)]
escapeMap of 
                                          Maybe Char
Nothing -> forall a. a -> Maybe a
Just ([Char]
chars forall a. [a] -> [a] -> [a]
++ [Char
nextChar]) --there is no escape sequence, so leave backslash + char
                                          Just Char
escapeVal -> forall a. a -> Maybe a
Just (forall a. [a] -> [a]
init [Char]
chars forall a. [a] -> [a] -> [a]
++ [Char
escapeVal]) -- nuke the backslash and add the escapeVal
                                   | Char
nextChar forall a. Eq a => a -> a -> Bool
== Char
'"' -> forall a. Maybe a
Nothing
                                   | Bool
otherwise -> forall a. a -> Maybe a
Just ([Char]
chars forall a. [a] -> [a] -> [a]
++ [Char
nextChar]))
  Parser ()
doubleQuote
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Text
T.pack [Char]
s)