-- {-# LANGUAGE ScopedTypeVariables #-}
-- Copyright 2024 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY WARRANTY
-- OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT
-- LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO
-- SPECIFICATIONS, ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
-- PARTICULAR PURPOSE, OR FREEDOM FROM INFRINGEMENT, ANY WARRANTY THAT THE
-- SUBJECT SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY THAT DOCUMENTATION, IF
-- PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN
-- ANY MANNER, CONSTITUTE AN ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR
-- RECIPIENT OF ANY RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR
-- ANY OTHER APPLICATIONS RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER,
-- GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING
-- THIRD-PARTY SOFTWARE, IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES
-- IT "AS IS."
--
-- Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS AGAINST
-- THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS
-- ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN
-- ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR LOSSES ARISING FROM SUCH USE,
-- INCLUDING ANY DAMAGES FROM PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S
-- USE OF THE SUBJECT SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE
-- UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY
-- PRIOR RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY
-- FOR ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS
-- AGREEMENT.

-- | Parser for Ogma specs stored in CSV files.
module Language.CSVSpec.Parser where

-- External imports
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

-- External imports: ogma-spec
import Data.OgmaSpec (Requirement (..), Spec (Spec))

-- | Area of the CSV file that contains the information of interest.
data CSVFormat = CSVFormat
    { CSVFormat -> Bool
skipHeaders               :: 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)

-- | Parse a CSV file and extract a Spec from it.
--
-- An auxiliary function must be provided to parse the requirement expressions.
--
-- Fails if any of the columns indicate a column out of range, of if the CSV is
-- malformed.
parseCSVSpec :: (String -> IO (Either String a)) -- ^ Parser for expressions.
             -> a                                -- ^ Default property value.
             -> CSVFormat                        -- ^ CSV file format spec.
             -> String                           -- ^ String containing CSV.
             -> 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'