{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- Copyright 2022 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- Disclaimers
--
-- 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.
--
-- | Parsing of specs.
module Data.Spec.Parser
    ( readInputExpr
    , readInputFile
    )
  where

-- External imports
import qualified Control.Exception    as E
import           Control.Monad.Except (ExceptT (..))
import           Data.Aeson           (eitherDecode)
import qualified Data.ByteString.Lazy as L
import           Data.List            (isInfixOf, isPrefixOf, nub, (\\))
import           System.Directory     (doesFileExist)
import           System.FilePath      ((</>))
import           System.Process       (readProcess)

-- External imports: auxiliary
import Data.ByteString.Extra as B (safeReadFile)
import Data.String.Extra     (sanitizeLCIdentifier, sanitizeUCIdentifier)

-- External imports: ogma
import Data.OgmaSpec            (ExternalVariableDef (..),
                                 InternalVariableDef (..), Requirement (..),
                                 Spec (..))
import Language.CSVSpec.Parser  (parseCSVSpec)
import Language.JSONSpec.Parser (parseJSONSpec)
import Language.XLSXSpec.Parser (parseXLSXSpec)
import Language.XMLSpec.Parser  (parseXMLSpec)
import Language.YAMLSpec.Parser (parseYAMLSpec)

-- Internal imports: auxiliary
import Command.Errors    (ErrorTriplet(..), ErrorCode)
import Data.Diagram      (Diagram)
import Data.Either.Extra (mapLeft)
import Data.ExprPair     (ExprPairT(..))
import Data.Location     (Location (..))
import Paths_ogma_core   (getDataDir)

-- | Process input specification from a single expression and return its
-- abstract representation.
readInputExpr :: String
              -> String
              -> Maybe String
              -> ExprPairT a
              -> ExceptT ErrorTriplet IO (Spec a)
readInputExpr :: forall a.
String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
readInputExpr String
expr String
propFormatName Maybe String
propVia ExprPairT a
exprT =
  IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorTriplet (Spec a))
 -> ExceptT ErrorTriplet IO (Spec a))
-> IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
forall a b. (a -> b) -> a -> b
$ do
    let ExprPairT String -> Either String a
parse [(String, String)] -> a -> a
replace a -> String
print a -> [String]
ids a
def = ExprPairT a
exprT

    let wrapper :: String -> IO (Either String a)
wrapper = Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
forall a.
Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
wrapVia Maybe String
propVia String -> Either String a
parse

    result <- String -> IO (Either String a)
wrapper String
expr

    let spec = do
          expr' <- Either String a
result
          let req = String -> a -> String -> Maybe String -> Maybe a -> Requirement a
forall a.
String -> a -> String -> Maybe String -> Maybe a -> Requirement a
Requirement String
"triggerCondition" a
expr' String
"" Maybe String
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing
          return $ Spec [] [] [ req ]

    -- Return the spec, transforming the error message if applicable.
    pure $ mapLeft (cannotReadConditionExpr expr) spec

--- | Process input specification, if available, and return its abstract
--- representation.
readInputFile :: FilePath
              -> String
              -> String
              -> Maybe String
              -> ExprPairT a
              -> ExceptT ErrorTriplet IO (Spec a)
readInputFile :: forall a.
String
-> String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
readInputFile String
fp String
formatName String
propFormatName Maybe String
propVia ExprPairT a
exprT =
  IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorTriplet (Spec a))
 -> ExceptT ErrorTriplet IO (Spec a))
-> IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
forall a b. (a -> b) -> a -> b
$ do
    let ExprPairT String -> Either String a
parse [(String, String)] -> a -> a
replace a -> String
print a -> [String]
ids a
def = ExprPairT a
exprT

    let wrapper :: String -> IO (Either String a)
wrapper = Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
forall a.
Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
wrapVia Maybe String
propVia String -> Either String a
parse
    -- Obtain format file.
    --
    -- A format name that exists as a file in the disk always takes preference
    -- over a file format included with Ogma. A file format with a forward
    -- slash in the name is always assumed to be a user-provided filename.
    -- Regardless of whether the file is user-provided or known to Ogma, we
    -- check (again) whether the file exists, and print an error message if
    -- not.
    exists  <- String -> IO Bool
doesFileExist String
formatName
    dataDir <- getDataDir
    let formatFile
          | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"/" String
formatName Bool -> Bool -> Bool
|| Bool
exists
          = String
formatName
          | Bool
otherwise
          = String
dataDir String -> String -> String
</> String
"data" String -> String -> String
</> String
"formats" String -> String -> String
</>
               (String
formatName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
propFormatName)
    formatMissing <- not <$> doesFileExist formatFile

    if formatMissing
      then return $ Left $ commandIncorrectFormatSpec formatFile
      else do
        res <- do
          format <- readFile formatFile

          -- All of the following operations use Either to return error
          -- messages.  The use of the monadic bind to pass arguments from one
          -- function to the next will cause the program to stop at the
          -- earliest error.
          if | isPrefixOf "XMLFormat" format
             -> do let xmlFormat = String -> XMLFormat
forall a. Read a => String -> a
read String
format
                   content <- readFile fp
                   parseXMLSpec
                     (wrapper) (def) xmlFormat content
                     -- (fmap (fmap print) . wrapper) (print def) xmlFormat content
             | isPrefixOf "CSVFormat" format
             -> do let csvFormat = String -> CSVFormat
forall a. Read a => String -> a
read String
format
                   content <- readFile fp
                   parseCSVSpec wrapper def csvFormat content
             | isPrefixOf "XLSXFormat" format
             -> do let xlsxFormat = String -> XLSXFormat
forall a. Read a => String -> a
read String
format
                   content <- L.readFile fp
                   parseXLSXSpec wrapper def xlsxFormat content
             | isPrefixOf "YAMLFormat" format
             -> do let yamlFormat = String -> YAMLFormat
forall a. Read a => String -> a
read String
format
                   content <- B.safeReadFile fp
                   case content of
                     Left String
e  -> 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
e
                     Right ByteString
b -> (String -> IO (Either String a))
-> YAMLFormat -> ByteString -> IO (Either String (Spec a))
forall a.
(String -> IO (Either String a))
-> YAMLFormat -> ByteString -> IO (Either String (Spec a))
parseYAMLSpec String -> IO (Either String a)
wrapper YAMLFormat
yamlFormat (ByteString -> ByteString
L.toStrict ByteString
b)
             | otherwise
             -> do let jsonFormat = String -> JSONFormat
forall a. Read a => String -> a
read String
format
                   content <- B.safeReadFile fp
                   case content of
                     Left String
e  -> 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
e
                     Right ByteString
b -> do case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
b of
                                     Left String
e  -> 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
e
                                     Right Value
v ->
                                       (String -> IO (Either String a))
-> JSONFormat -> Value -> IO (Either String (Spec a))
forall a.
(String -> IO (Either String a))
-> JSONFormat -> Value -> IO (Either String (Spec a))
parseJSONSpec
                                         (String -> IO (Either String a)
wrapper)
                                         JSONFormat
jsonFormat
                                         Value
v
        case res of
          Left String
e  -> Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a)))
-> Either ErrorTriplet (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall a b. (a -> b) -> a -> b
$ ErrorTriplet -> Either ErrorTriplet (Spec a)
forall a b. a -> Either a b
Left (ErrorTriplet -> Either ErrorTriplet (Spec a))
-> ErrorTriplet -> Either ErrorTriplet (Spec a)
forall a b. (a -> b) -> a -> b
$ String -> ErrorTriplet
cannotOpenInputFile String
fp
          Right Spec a
x -> Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a)))
-> Either ErrorTriplet (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall a b. (a -> b) -> a -> b
$ Spec a -> Either ErrorTriplet (Spec a)
forall a b. b -> Either a b
Right Spec a
x



-- | Exception handler to deal with the case in which the trigger expression
-- cannot be understood.
cannotReadConditionExpr :: String -> String -> ErrorTriplet
cannotReadConditionExpr :: String -> String -> ErrorTriplet
cannotReadConditionExpr String
expr String
errorMsg =
    ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotReadConditionExpr String
msg Location
LocationNothing
  where
    msg :: String
msg =
      String
"cannot parse condition or trigger expression " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
expr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg

-- | Exception handler to deal with the case in which the input file cannot be
-- opened.
cannotOpenInputFile :: FilePath -> ErrorTriplet
cannotOpenInputFile :: String -> ErrorTriplet
cannotOpenInputFile String
file =
    ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotOpenInputFile String
msg (String -> Location
LocationFile String
file)
  where
    msg :: String
msg =
      String
"cannot open input specification file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file

-- | Error message associated to the format file not being found.
commandIncorrectFormatSpec :: FilePath -> ErrorTriplet
commandIncorrectFormatSpec :: String -> ErrorTriplet
commandIncorrectFormatSpec String
formatFile =
    ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecIncorrectFormatFile String
msg (String -> Location
LocationFile String
formatFile)
  where
    msg :: String
msg =
      String
"The format specification " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
formatFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist or is not "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"readable"

-- ** Error codes

-- | Error: the trigger expression provided by the user cannot be parsed.
ecCannotReadConditionExpr :: ErrorCode
ecCannotReadConditionExpr :: ErrorCode
ecCannotReadConditionExpr = ErrorCode
1

-- | Error: the input specification provided by the user cannot be opened.
ecCannotOpenInputFile :: ErrorCode
ecCannotOpenInputFile :: ErrorCode
ecCannotOpenInputFile = ErrorCode
1

-- | Error: the format file cannot be opened.
ecIncorrectFormatFile :: ErrorCode
ecIncorrectFormatFile :: ErrorCode
ecIncorrectFormatFile = ErrorCode
1

-- | Parse a property using an auxiliary program to first translate it, if
-- available.
--
-- If a program is given, it is first called on the property, and then the
-- result is parsed with the parser passed as an argument. If a program is not
-- given, then the parser is applied to the given string.
wrapVia :: Maybe String                -- ^ Auxiliary program to translate the
                                       -- property.
        -> (String -> Either String a) -- ^ Parser used on the result.
        -> String                      -- ^ Property to parse.
        -> IO (Either String a)
wrapVia :: forall a.
Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
wrapVia Maybe String
Nothing  String -> Either String a
parse String
s = Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String a
parse String
s)
wrapVia (Just String
f) String -> Either String a
parse String
s =
  (IOException -> IO (Either String a))
-> IO (Either String a) -> IO (Either String a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(IOException
e :: E.IOException) -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
e) (IO (Either String a) -> IO (Either String a))
-> IO (Either String a) -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ do
    out <- String -> [String] -> String -> IO String
readProcess String
f [] String
s
    return $ parse out