ogma-language-csv-1.10.0: src/Language/CSVSpec/Parser.hs
-- {-# LANGUAGE ScopedTypeVariables #-}
-- Copyright 2024 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may
-- not use this file except in compliance with the License. You may obtain a
-- copy of the License at
--
-- https://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations
-- under the License.
-- | 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
{ skipHeaders :: Bool
, specRequirementId :: Int
, specRequirementDesc :: Maybe Int
, specRequirementExpr :: Int
, specRequirementResultType :: Maybe Int
, specRequirementResultExpr :: Maybe Int
}
deriving (Show, 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 parseExpr _defA csvFormat value = do
let bsToString = T.unpack . T.decodeUtf8
stringToBS = TL.encodeUtf8 . TL.pack
let internalVariableDefs = []
externalVariableDefs = []
csvData = stringToBS value
case decode NoHeader csvData of
Left err -> return $ Left err
Right v -> do
let vl = V.toList (v :: V.Vector Record)
v' = if skipHeaders csvFormat then tail vl else vl
rs <- forM v' $ \row -> do
let rowL = V.toList row
expr <- parseExpr $ bsToString $
rowL !! specRequirementExpr csvFormat
exprR <- maybe (return $ Right Nothing)
(\ix -> fmap Just <$>
(parseExpr $ bsToString $ rowL !! ix))
(specRequirementResultExpr csvFormat)
case (expr, exprR) of
(Left e, _)
-> return $ Left $ "The CSV data could not be parsed: " ++ e
(_, Left e)
-> return $ Left $ "The CSV data could not be parsed: " ++ e
(Right e, Right rE) -> return $ Right $
Requirement
{ requirementName =
bsToString $ rowL !! specRequirementId csvFormat
, requirementDescription =
maybe "" (bsToString . (rowL !!)) $
specRequirementDesc csvFormat
, requirementExpr = e
, requirementResultType =
fmap (bsToString . (rowL !!)) $
specRequirementResultType csvFormat
, requirementResultExpr = rE
}
case sequence rs of
Left err -> return $ Left err
Right rs' -> return $ Right $
Spec internalVariableDefs externalVariableDefs rs'