module Language.XLSXSpec.Parser (XLSXFormat(..), parseXLSXSpec) where
import Codec.Xlsx (Cell, CellValue (..), ColumnIndex (..),
ParseError (..), _cellValue, _wsCells,
_xlSheets, toRows, toXlsxEither)
import Control.Monad (forM, sequence)
import qualified Data.ByteString.Lazy as L
import Data.List (lookup)
import Data.Maybe (catMaybes, fromJust, isNothing)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.OgmaSpec (Requirement (..), Spec (Spec))
data XLSXFormat = XLSXFormat
{ :: Bool
, XLSXFormat -> String
specRequirementSheet :: String
, XLSXFormat -> Int
specRequirementId :: Int
, XLSXFormat -> Maybe Int
specRequirementDesc :: Maybe Int
, XLSXFormat -> Int
specRequirementExpr :: Int
, XLSXFormat -> Maybe Int
specRequirementResultType :: Maybe Int
, XLSXFormat -> Maybe Int
specRequirementResultExpr :: Maybe Int
}
deriving (ReadPrec [XLSXFormat]
ReadPrec XLSXFormat
Int -> ReadS XLSXFormat
ReadS [XLSXFormat]
(Int -> ReadS XLSXFormat)
-> ReadS [XLSXFormat]
-> ReadPrec XLSXFormat
-> ReadPrec [XLSXFormat]
-> Read XLSXFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS XLSXFormat
readsPrec :: Int -> ReadS XLSXFormat
$creadList :: ReadS [XLSXFormat]
readList :: ReadS [XLSXFormat]
$creadPrec :: ReadPrec XLSXFormat
readPrec :: ReadPrec XLSXFormat
$creadListPrec :: ReadPrec [XLSXFormat]
readListPrec :: ReadPrec [XLSXFormat]
Read)
parseXLSXSpec :: (String -> IO (Either String a))
-> a
-> XLSXFormat
-> L.ByteString
-> IO (Either String (Spec a))
parseXLSXSpec :: forall a.
(String -> IO (Either String a))
-> a -> XLSXFormat -> ByteString -> IO (Either String (Spec a))
parseXLSXSpec String -> IO (Either String a)
parseExpr a
_defA XLSXFormat
xlsxFormat ByteString
value = do
let internalVariableDefs :: [a]
internalVariableDefs = []
externalVariableDefs :: [a]
externalVariableDefs = []
let sheets :: Either ParseError [(Text, Worksheet)]
sheets = Xlsx -> [(Text, Worksheet)]
_xlSheets (Xlsx -> [(Text, Worksheet)])
-> Either ParseError Xlsx -> Either ParseError [(Text, Worksheet)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either ParseError Xlsx
toXlsxEither ByteString
value
case Either ParseError [(Text, Worksheet)]
sheets of
Left ParseError
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 -> Either String (Spec a))
-> String -> Either String (Spec a)
forall a b. (a -> b) -> a -> b
$ ParseError -> String
showParseError ParseError
err
Right [(Text, Worksheet)]
sheets' -> do
let sheet :: Worksheet
sheet = Maybe Worksheet -> Worksheet
forall a. HasCallStack => Maybe a -> a
fromJust
(Maybe Worksheet -> Worksheet) -> Maybe Worksheet -> Worksheet
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Worksheet)] -> Maybe Worksheet
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Text
T.pack (XLSXFormat -> String
specRequirementSheet XLSXFormat
xlsxFormat)) [(Text, Worksheet)]
sheets'
let rows :: [(RowIndex, [(ColumnIndex, Cell)])]
rows = if XLSXFormat -> Bool
skipHeaders XLSXFormat
xlsxFormat then [(RowIndex, [(ColumnIndex, Cell)])]
-> [(RowIndex, [(ColumnIndex, Cell)])]
forall a. HasCallStack => [a] -> [a]
tail [(RowIndex, [(ColumnIndex, Cell)])]
rows' else [(RowIndex, [(ColumnIndex, Cell)])]
rows'
rows' :: [(RowIndex, [(ColumnIndex, Cell)])]
rows' = CellMap -> [(RowIndex, [(ColumnIndex, Cell)])]
toRows (CellMap -> [(RowIndex, [(ColumnIndex, Cell)])])
-> CellMap -> [(RowIndex, [(ColumnIndex, Cell)])]
forall a b. (a -> b) -> a -> b
$ Worksheet -> CellMap
_wsCells Worksheet
sheet
[Either String (Maybe (Requirement a))]
rs <- [(RowIndex, [(ColumnIndex, Cell)])]
-> ((RowIndex, [(ColumnIndex, Cell)])
-> IO (Either String (Maybe (Requirement a))))
-> IO [Either String (Maybe (Requirement a))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(RowIndex, [(ColumnIndex, Cell)])]
rows (((RowIndex, [(ColumnIndex, Cell)])
-> IO (Either String (Maybe (Requirement a))))
-> IO [Either String (Maybe (Requirement a))])
-> ((RowIndex, [(ColumnIndex, Cell)])
-> IO (Either String (Maybe (Requirement a))))
-> IO [Either String (Maybe (Requirement a))]
forall a b. (a -> b) -> a -> b
$ \(RowIndex
_, [(ColumnIndex, Cell)]
row) -> do
if XLSXFormat -> [(ColumnIndex, Cell)] -> Bool
emptyRow XLSXFormat
xlsxFormat [(ColumnIndex, Cell)]
row
then Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a))))
-> Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Requirement a) -> Either String (Maybe (Requirement a))
forall a b. b -> Either a b
Right Maybe (Requirement a)
forall a. Maybe a
Nothing
else do
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
$ Int -> [(ColumnIndex, Cell)] -> String
rowCell (XLSXFormat -> Int
specRequirementExpr XLSXFormat
xlsxFormat) [(ColumnIndex, Cell)]
row
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 (Int -> [(ColumnIndex, Cell)] -> String
rowCell Int
ix [(ColumnIndex, Cell)]
row))
(XLSXFormat -> Maybe Int
specRequirementResultExpr XLSXFormat
xlsxFormat)
case (Either String a
expr, Either String (Maybe a)
exprR) of
(Left String
e, Either String (Maybe a)
_) ->
Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a))))
-> Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Maybe (Requirement a))
forall a b. a -> Either a b
Left (String -> Either String (Maybe (Requirement a)))
-> String -> Either String (Maybe (Requirement a))
forall a b. (a -> b) -> a -> b
$ String
"The XLSX data could not be parsed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
(Either String a
_, Left String
e) ->
Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a))))
-> Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Maybe (Requirement a))
forall a b. a -> Either a b
Left (String -> Either String (Maybe (Requirement a)))
-> String -> Either String (Maybe (Requirement a))
forall a b. (a -> b) -> a -> b
$ String
"The XLSX data could not be parsed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
(Right a
e, Right Maybe a
rE) -> Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a))))
-> Either String (Maybe (Requirement a))
-> IO (Either String (Maybe (Requirement a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Requirement a) -> Either String (Maybe (Requirement a))
forall a b. b -> Either a b
Right (Maybe (Requirement a) -> Either String (Maybe (Requirement a)))
-> Maybe (Requirement a) -> Either String (Maybe (Requirement a))
forall a b. (a -> b) -> a -> b
$ Requirement a -> Maybe (Requirement a)
forall a. a -> Maybe a
Just
Requirement
{ requirementName :: String
requirementName =
Int -> [(ColumnIndex, Cell)] -> String
rowCell (XLSXFormat -> Int
specRequirementId XLSXFormat
xlsxFormat) [(ColumnIndex, Cell)]
row
, requirementDescription :: String
requirementDescription =
String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Int -> [(ColumnIndex, Cell)] -> String
`rowCell` [(ColumnIndex, Cell)]
row) (XLSXFormat -> Maybe Int
specRequirementDesc XLSXFormat
xlsxFormat)
, 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
(Int -> [(ColumnIndex, Cell)] -> String
`rowCell` [(ColumnIndex, Cell)]
row)
(XLSXFormat -> Maybe Int
specRequirementResultType XLSXFormat
xlsxFormat)
, requirementResultExpr :: Maybe a
requirementResultExpr = Maybe a
rE
}
case ([Maybe (Requirement a)] -> [Requirement a])
-> Either String [Maybe (Requirement a)]
-> Either String [Requirement 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 [Maybe (Requirement a)] -> [Requirement a]
forall a. [Maybe a] -> [a]
catMaybes ([Either String (Maybe (Requirement a))]
-> Either String [Maybe (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 (Maybe (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'
emptyRow :: XLSXFormat -> [(ColumnIndex, Cell)] -> Bool
emptyRow :: XLSXFormat -> [(ColumnIndex, Cell)] -> Bool
emptyRow XLSXFormat
xlsxFormat [(ColumnIndex, Cell)]
row =
Int -> [(ColumnIndex, Cell)] -> Bool
emptyCell (XLSXFormat -> Int
specRequirementExpr XLSXFormat
xlsxFormat) [(ColumnIndex, Cell)]
row
Bool -> Bool -> Bool
|| Int -> [(ColumnIndex, Cell)] -> Bool
emptyCell (XLSXFormat -> Int
specRequirementId XLSXFormat
xlsxFormat) [(ColumnIndex, Cell)]
row
Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> [(ColumnIndex, Cell)] -> Bool
`emptyCell` [(ColumnIndex, Cell)]
row)
(XLSXFormat -> Maybe Int
specRequirementDesc XLSXFormat
xlsxFormat)
Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> [(ColumnIndex, Cell)] -> Bool
`emptyCell` [(ColumnIndex, Cell)]
row)
(XLSXFormat -> Maybe Int
specRequirementResultExpr XLSXFormat
xlsxFormat)
Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> [(ColumnIndex, Cell)] -> Bool
`emptyCell` [(ColumnIndex, Cell)]
row)
(XLSXFormat -> Maybe Int
specRequirementResultType XLSXFormat
xlsxFormat)
emptyCell :: Int -> [(ColumnIndex, Cell)] -> Bool
emptyCell :: Int -> [(ColumnIndex, Cell)] -> Bool
emptyCell Int
i [(ColumnIndex, Cell)]
row = Maybe Cell -> Bool
forall a. Maybe a -> Bool
isNothing (ColumnIndex -> [(ColumnIndex, Cell)] -> Maybe Cell
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> ColumnIndex
ColumnIndex Int
i) [(ColumnIndex, Cell)]
row)
rowCell :: Int -> [(ColumnIndex, Cell)] -> String
rowCell :: Int -> [(ColumnIndex, Cell)] -> String
rowCell Int
i [(ColumnIndex, Cell)]
row = CellValue -> String
cellValueToString
(CellValue -> String) -> CellValue -> String
forall a b. (a -> b) -> a -> b
$ Maybe CellValue -> CellValue
forall a. HasCallStack => Maybe a -> a
fromJust
(Maybe CellValue -> CellValue) -> Maybe CellValue -> CellValue
forall a b. (a -> b) -> a -> b
$ Cell -> Maybe CellValue
_cellValue
(Cell -> Maybe CellValue) -> Cell -> Maybe CellValue
forall a b. (a -> b) -> a -> b
$ Maybe Cell -> Cell
forall a. HasCallStack => Maybe a -> a
fromJust
(Maybe Cell -> Cell) -> Maybe Cell -> Cell
forall a b. (a -> b) -> a -> b
$ ColumnIndex -> [(ColumnIndex, Cell)] -> Maybe Cell
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> ColumnIndex
ColumnIndex Int
i) [(ColumnIndex, Cell)]
row
cellValueToString :: CellValue -> String
cellValueToString :: CellValue -> String
cellValueToString (CellText Text
txt) = Text -> String
T.unpack Text
txt
cellValueToString (CellDouble Double
n) = Double -> String
forall a. Show a => a -> String
show Double
n
cellValueToString (CellBool Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
cellValueToString (CellRich [RichTextRun]
_) = String
"(unsupported)"
cellValueToString (CellError ErrorType
_) = String
"(error)"
showParseError :: ParseError -> String
showParseError :: ParseError -> String
showParseError (InvalidZipArchive String
string) = String
"Invalid zip archive: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
string
showParseError (MissingFile String
fp) = String
"Missing file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp
showParseError (InvalidFile String
fp Text
txt) = String
"Invalid file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp
showParseError (InvalidRef String
fp RefId
refId) = String
"Invalid reference in file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp
showParseError (InconsistentXlsx Text
txt) = String
"Inconsistent XLSX file"