module Language.CSVSpec.Parser where
import Control.Monad (forM, sequence)
import Data.Csv (HasHeader (NoHeader), Record, decode)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Vector as V
import Data.OgmaSpec (Requirement (..), Spec (Spec))
data CSVFormat = CSVFormat
{ :: Bool
, CSVFormat -> Int
specRequirementId :: Int
, CSVFormat -> Maybe Int
specRequirementDesc :: Maybe Int
, CSVFormat -> Int
specRequirementExpr :: Int
, CSVFormat -> Maybe Int
specRequirementResultType :: Maybe Int
, CSVFormat -> Maybe Int
specRequirementResultExpr :: Maybe Int
}
deriving (Int -> CSVFormat -> ShowS
[CSVFormat] -> ShowS
CSVFormat -> String
(Int -> CSVFormat -> ShowS)
-> (CSVFormat -> String)
-> ([CSVFormat] -> ShowS)
-> Show CSVFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSVFormat -> ShowS
showsPrec :: Int -> CSVFormat -> ShowS
$cshow :: CSVFormat -> String
show :: CSVFormat -> String
$cshowList :: [CSVFormat] -> ShowS
showList :: [CSVFormat] -> ShowS
Show, ReadPrec [CSVFormat]
ReadPrec CSVFormat
Int -> ReadS CSVFormat
ReadS [CSVFormat]
(Int -> ReadS CSVFormat)
-> ReadS [CSVFormat]
-> ReadPrec CSVFormat
-> ReadPrec [CSVFormat]
-> Read CSVFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CSVFormat
readsPrec :: Int -> ReadS CSVFormat
$creadList :: ReadS [CSVFormat]
readList :: ReadS [CSVFormat]
$creadPrec :: ReadPrec CSVFormat
readPrec :: ReadPrec CSVFormat
$creadListPrec :: ReadPrec [CSVFormat]
readListPrec :: ReadPrec [CSVFormat]
Read)
parseCSVSpec :: (String -> IO (Either String a))
-> a
-> CSVFormat
-> String
-> IO (Either String (Spec a))
parseCSVSpec :: forall a.
(String -> IO (Either String a))
-> a -> CSVFormat -> String -> IO (Either String (Spec a))
parseCSVSpec String -> IO (Either String a)
parseExpr a
_defA CSVFormat
csvFormat String
value = do
let bsToString :: ByteString -> String
bsToString = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8
stringToBS :: String -> ByteString
stringToBS = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
let internalVariableDefs :: [a]
internalVariableDefs = []
externalVariableDefs :: [a]
externalVariableDefs = []
csvData :: ByteString
csvData = String -> ByteString
stringToBS String
value
case HasHeader -> ByteString -> Either String (Vector Record)
forall a.
FromRecord a =>
HasHeader -> ByteString -> Either String (Vector a)
decode HasHeader
NoHeader ByteString
csvData of
Left String
err -> Either String (Spec a) -> IO (Either String (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Spec a) -> IO (Either String (Spec a)))
-> Either String (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Spec a)
forall a b. a -> Either a b
Left String
err
Right Vector Record
v -> do
let vl :: [Record]
vl = Vector Record -> [Record]
forall a. Vector a -> [a]
V.toList (Vector Record
v :: V.Vector Record)
v' :: [Record]
v' = if CSVFormat -> Bool
skipHeaders CSVFormat
csvFormat then [Record] -> [Record]
forall a. HasCallStack => [a] -> [a]
tail [Record]
vl else [Record]
vl
[Either String (Requirement a)]
rs <- [Record]
-> (Record -> IO (Either String (Requirement a)))
-> IO [Either String (Requirement a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Record]
v' ((Record -> IO (Either String (Requirement a)))
-> IO [Either String (Requirement a)])
-> (Record -> IO (Either String (Requirement a)))
-> IO [Either String (Requirement a)]
forall a b. (a -> b) -> a -> b
$ \Record
row -> do
let rowL :: [ByteString]
rowL = Record -> [ByteString]
forall a. Vector a -> [a]
V.toList Record
row
Either String a
expr <- String -> IO (Either String a)
parseExpr (String -> IO (Either String a)) -> String -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ ByteString -> String
bsToString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
[ByteString]
rowL [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! CSVFormat -> Int
specRequirementExpr CSVFormat
csvFormat
Either String (Maybe a)
exprR <- IO (Either String (Maybe a))
-> (Int -> IO (Either String (Maybe a)))
-> Maybe Int
-> IO (Either String (Maybe a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either String (Maybe a) -> IO (Either String (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe a) -> IO (Either String (Maybe a)))
-> Either String (Maybe a) -> IO (Either String (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
(\Int
ix -> (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Either String (Maybe a))
-> IO (Either String a) -> IO (Either String (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(String -> IO (Either String a)
parseExpr (String -> IO (Either String a)) -> String -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ ByteString -> String
bsToString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
rowL [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
ix))
(CSVFormat -> Maybe Int
specRequirementResultExpr CSVFormat
csvFormat)
case (Either String a
expr, Either String (Maybe a)
exprR) of
(Left String
e, Either String (Maybe a)
_)
-> Either String (Requirement a) -> IO (Either String (Requirement a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Requirement a)
-> IO (Either String (Requirement a)))
-> Either String (Requirement a)
-> IO (Either String (Requirement a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Requirement a)
forall a b. a -> Either a b
Left (String -> Either String (Requirement a))
-> String -> Either String (Requirement a)
forall a b. (a -> b) -> a -> b
$ String
"The CSV data could not be parsed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
(Either String a
_, Left String
e)
-> Either String (Requirement a) -> IO (Either String (Requirement a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Requirement a)
-> IO (Either String (Requirement a)))
-> Either String (Requirement a)
-> IO (Either String (Requirement a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Requirement a)
forall a b. a -> Either a b
Left (String -> Either String (Requirement a))
-> String -> Either String (Requirement a)
forall a b. (a -> b) -> a -> b
$ String
"The CSV data could not be parsed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
(Right a
e, Right Maybe a
rE) -> Either String (Requirement a) -> IO (Either String (Requirement a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Requirement a)
-> IO (Either String (Requirement a)))
-> Either String (Requirement a)
-> IO (Either String (Requirement a))
forall a b. (a -> b) -> a -> b
$ Requirement a -> Either String (Requirement a)
forall a b. b -> Either a b
Right (Requirement a -> Either String (Requirement a))
-> Requirement a -> Either String (Requirement a)
forall a b. (a -> b) -> a -> b
$
Requirement
{ requirementName :: String
requirementName =
ByteString -> String
bsToString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
rowL [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! CSVFormat -> Int
specRequirementId CSVFormat
csvFormat
, requirementDescription :: String
requirementDescription =
String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (ByteString -> String
bsToString (ByteString -> String) -> (Int -> ByteString) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString]
rowL [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!!)) (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$
CSVFormat -> Maybe Int
specRequirementDesc CSVFormat
csvFormat
, requirementExpr :: a
requirementExpr = a
e
, requirementResultType :: Maybe String
requirementResultType =
(Int -> String) -> Maybe Int -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> String
bsToString (ByteString -> String) -> (Int -> ByteString) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString]
rowL [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!!)) (Maybe Int -> Maybe String) -> Maybe Int -> Maybe String
forall a b. (a -> b) -> a -> b
$
CSVFormat -> Maybe Int
specRequirementResultType CSVFormat
csvFormat
, requirementResultExpr :: Maybe a
requirementResultExpr = Maybe a
rE
}
case [Either String (Requirement a)] -> Either String [Requirement a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either String (Requirement a)]
rs of
Left String
err -> Either String (Spec a) -> IO (Either String (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Spec a) -> IO (Either String (Spec a)))
-> Either String (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Spec a)
forall a b. a -> Either a b
Left String
err
Right [Requirement a]
rs' -> Either String (Spec a) -> IO (Either String (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Spec a) -> IO (Either String (Spec a)))
-> Either String (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ Spec a -> Either String (Spec a)
forall a b. b -> Either a b
Right (Spec a -> Either String (Spec a))
-> Spec a -> Either String (Spec a)
forall a b. (a -> b) -> a -> b
$
[InternalVariableDef]
-> [ExternalVariableDef] -> [Requirement a] -> Spec a
forall a.
[InternalVariableDef]
-> [ExternalVariableDef] -> [Requirement a] -> Spec a
Spec [InternalVariableDef]
forall a. [a]
internalVariableDefs [ExternalVariableDef]
forall a. [a]
externalVariableDefs [Requirement a]
rs'