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 -> String
(Int -> CsvImportError -> ShowS)
-> (CsvImportError -> String)
-> ([CsvImportError] -> ShowS)
-> Show CsvImportError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CsvImportError] -> ShowS
$cshowList :: [CsvImportError] -> ShowS
show :: CsvImportError -> String
$cshow :: CsvImportError -> String
showsPrec :: Int -> CsvImportError -> ShowS
$cshowsPrec :: Int -> CsvImportError -> ShowS
Show)

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


parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> APT.Parser (Either RelationalError Atom)
parseCSVAtomP :: Text
-> TypeConstructorMapping
-> AtomType
-> Parser (Either RelationalError Atom)
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
IntegerAtomType = Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Integer -> Atom) -> Integer -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Atom
IntegerAtom (Integer -> Either RelationalError Atom)
-> Parser Text Integer -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Integer
forall a. Integral a => Parser a
APT.decimal
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
IntAtomType = Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Int -> Atom) -> Int -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Atom
IntAtom (Int -> Either RelationalError Atom)
-> Parser Text Int -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
APT.decimal
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
ScientificAtomType = Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Scientific -> Atom)
-> Scientific
-> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Atom
ScientificAtom (Scientific -> Either RelationalError Atom)
-> Parser Text Scientific -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scientific
APT.scientific
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
DoubleAtomType = Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Double -> Atom) -> Double -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Atom
DoubleAtom (Double -> Either RelationalError Atom)
-> Parser Text Double -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Double
APT.double
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
TextAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Text -> Atom) -> Text -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Atom
TextAtom (Text -> Either RelationalError Atom)
-> Parser Text Text -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
quotedString Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
takeToEndOfData)
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
DayAtomType = do
  String
dString <- Text -> String
T.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeToEndOfData
  case String -> Maybe Day
forall a. Read a => String -> Maybe a
readMaybe String
dString of
    Maybe Day
Nothing -> String -> Parser (Either RelationalError Atom)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Day string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dString)
    Just Day
date -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Day -> Atom
DayAtom Day
date))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
DateTimeAtomType = do    
  String
dString <- Text -> String
T.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeToEndOfData
  case String -> Maybe UTCTime
forall a. Read a => String -> Maybe a
readMaybe String
dString of
    Maybe UTCTime
Nothing -> String -> Parser (Either RelationalError Atom)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Date string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dString)
    Just UTCTime
date -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (UTCTime -> Atom
DateTimeAtom UTCTime
date))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
ByteStringAtomType = do    
  String
bsString <- Text -> String
T.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeToEndOfData
  case String -> Maybe ByteString
forall a. Read a => String -> Maybe a
readMaybe String
bsString of
    Maybe ByteString
Nothing -> String -> Parser (Either RelationalError Atom)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid ByteString string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bsString)
    Just ByteString
bs -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (ByteString -> Atom
ByteStringAtom ByteString
bs))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
BoolAtomType = do
  String
bString <- Text -> String
T.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeToEndOfData
  case String -> Maybe Bool
forall a. Read a => String -> Maybe a
readMaybe String
bString of
    Maybe Bool
Nothing -> String -> Parser (Either RelationalError Atom)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid BoolAtom string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bString)
    Just Bool
b -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Bool -> Atom
BoolAtom Bool
b))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
UUIDAtomType = do
  String
uString <- Text -> String
T.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeToEndOfData
  case String -> Maybe UUID
forall a. Read a => String -> Maybe a
readMaybe String
uString of
    Maybe UUID
Nothing -> String -> Parser (Either RelationalError Atom)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid UUIDAtom string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uString)
    Just UUID
u -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (UUID -> Atom
UUIDAtom UUID
u))
parseCSVAtomP Text
_ TypeConstructorMapping
_ AtomType
RelationalExprAtomType = do
  String
reString <- Text -> String
T.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeToEndOfData      
  case String -> Maybe RelationalExpr
forall a. Read a => String -> Maybe a
readMaybe String
reString of
    Maybe RelationalExpr
Nothing -> String -> Parser (Either RelationalError Atom)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid RelationalExprAtom string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reString)
    Just RelationalExpr
b -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
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) 
  | AtomType -> Bool
isIntervalAtomType AtomType
typ = do
    Bool
begin <- (Char -> Parser Char
APT.char Char
'[' Parser Char -> Parser Text Bool -> Parser Text Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser Text Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
APT.char Char
'(' Parser Char -> Parser Text Bool -> Parser Text Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Text Bool
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 (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
iType
    case Either RelationalError Atom
eBeginv of
      Left RelationalError
err -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
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 (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
iType
        case Either RelationalError Atom
eEndv of
          Left RelationalError
err -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err)
          Right Atom
endv -> do
            Bool
end <- (Char -> Parser Char
APT.char Char
']' Parser Char -> Parser Text Bool -> Parser Text Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser Text Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                   (Char -> Parser Char
APT.char Char
')' Parser Char -> Parser Text Bool -> Parser Text Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
            Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
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 Text
capitalizedIdentifier
    Parser Text ()
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 -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
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 -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err)
          Right [AtomType]
argAtomTypes -> do
            [Either RelationalError Atom]
atomArgs <- (AtomType -> Parser (Either RelationalError Atom))
-> [AtomType] -> Parser Text [Either RelationalError Atom]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\AtomType
argTyp -> let parseNextAtom :: Parser (Either RelationalError Atom)
parseNextAtom = Text
-> TypeConstructorMapping
-> AtomType
-> Parser (Either RelationalError Atom)
parseCSVAtomP Text
attrName TypeConstructorMapping
tConsMap AtomType
argTyp Parser (Either RelationalError Atom)
-> Parser Text () -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
APT.skipSpace in
                               case AtomType
argTyp of
                                 ConstructedAtomType Text
_ TypeVarMap
_ -> 
                                   Parser (Either RelationalError Atom)
-> Parser (Either RelationalError Atom)
forall a. Parser a -> Parser a
parens Parser (Either RelationalError Atom)
parseNextAtom Parser (Either RelationalError Atom)
-> Parser (Either RelationalError Atom)
-> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                   Parser (Either RelationalError Atom)
parseNextAtom
                                 AtomType
_ -> Parser (Either RelationalError Atom)
parseNextAtom
                             ) [AtomType]
argAtomTypes
            case [Either RelationalError Atom] -> [RelationalError]
forall a b. [Either a b] -> [a]
lefts [Either RelationalError Atom]
atomArgs of
              [] -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Text -> AtomType -> [Atom] -> Atom
ConstructedAtom Text
dConsName AtomType
typ ([Either RelationalError Atom] -> [Atom]
forall a b. [Either a b] -> [b]
rights [Either RelationalError Atom]
atomArgs)))
              [RelationalError]
errs -> Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left ([RelationalError] -> RelationalError
someErrors [RelationalError]
errs))
parseCSVAtomP Text
attrName TypeConstructorMapping
_ (RelationAtomType Attributes
_) = Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left ([Text] -> RelationalError
RelationValuedAttributesNotSupportedError [Text
attrName]))
parseCSVAtomP Text
_ TypeConstructorMapping
_ (TypeVariableType Text
x) = Either RelationalError Atom -> Parser (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left (Text -> RelationalError
TypeConstructorTypeVarMissing Text
x))
      
capitalizedIdentifier :: APT.Parser T.Text
capitalizedIdentifier :: Parser Text Text
capitalizedIdentifier = do
  Char
fletter <- (Char -> Bool) -> Parser Char
APT.satisfy Char -> Bool
isUpper Parser Char -> String -> Parser Char
forall i a. Parser i a -> String -> Parser i a
APT.<?> String
"capitalized data constructor letter"
  Text
rest <- (Char -> Bool) -> Parser Text Text
APT.takeWhile (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')) Parser Text Text -> String -> Parser Text Text
forall i a. Parser i a -> String -> Parser i a
APT.<?> String
"data constructor name"
  Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
fletter Char -> Text -> Text
`T.cons` Text
rest)
  
--read data for Text.Read parser but be wary of end of interval blocks  
takeToEndOfData :: APT.Parser T.Text
takeToEndOfData :: Parser Text Text
takeToEndOfData = (Char -> Bool) -> Parser Text Text
APT.takeWhile (String -> Char -> Bool
APT.notInClass String
",)]")
  
parens :: APT.Parser a -> APT.Parser a  
parens :: Parser a -> Parser a
parens Parser a
p = do
  Parser Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
APT.char Char
'('
  Parser Text ()
APT.skipSpace
  a
v <- Parser a
p
  Parser Text ()
APT.skipSpace
  Parser Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
APT.char Char
')'
  a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
  
quotedString :: APT.Parser T.Text
quotedString :: Parser Text Text
quotedString = do
  let escapeMap :: [(Char, Char)]
escapeMap = [(Char
'"',Char
'"'), (Char
'n', Char
'\n'), (Char
'r', Char
'\r')]
      doubleQuote :: Parser Text ()
doubleQuote = Parser Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
APT.char Char
'"'
  Parser Text ()
doubleQuote      
  (Text
_, String
s) <- String -> (String -> Char -> Maybe String) -> Parser (Text, String)
forall s. s -> (s -> Char -> Maybe s) -> Parser (Text, s)
APT.runScanner [] (\String
prevl Char
nextChar -> case String
prevl of
                             [] -> String -> Maybe String
forall a. a -> Maybe a
Just [Char
nextChar]
                             String
chars | String -> Char
forall a. [a] -> a
last String
chars Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' ->
                                        case Char -> [(Char, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
nextChar [(Char, Char)]
escapeMap of 
                                          Maybe Char
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just (String
chars String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
nextChar]) --there is no escape sequence, so leave backslash + char
                                          Just Char
escapeVal -> String -> Maybe String
forall a. a -> Maybe a
Just (ShowS
forall a. [a] -> [a]
init String
chars String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
escapeVal]) -- nuke the backslash and add the escapeVal
                                   | Char
nextChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' -> Maybe String
forall a. Maybe a
Nothing
                                   | Bool
otherwise -> String -> Maybe String
forall a. a -> Maybe a
Just (String
chars String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
nextChar]))
  Parser Text ()
doubleQuote
  Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
s)