content: {- Copyright 2013-2023 NGLess Authors
   - License: MIT
   -}
  {-# LANGUAGE FlexibleContexts #-}
  module NGLess
      ( NGLessIO
      , NGLess
      , NGError(..)
      , runNGLess
      , throwShouldNotOccur
      , throwScriptError
      , throwDataError
      , throwSystemError
      , throwGenericError
      , KwArgsValues
      , boolOrTypeError
      , symbolOrTypeError
      , stringOrTypeError
      , filepathOrTypeError
      , integerOrTypeError
      , decodeSymbolOrError
      , lookupBoolOrScriptError
      , lookupBoolOrScriptErrorDef
      , lookupStringOrScriptError
      , lookupStringOrScriptErrorDef
      , lookupStringListOrScriptError
      , lookupStringListOrScriptErrorDef
      , lookupIntegerOrScriptError
      , lookupIntegerOrScriptErrorDef
      , lookupDoubleOrScriptError
      , lookupDoubleOrScriptErrorDef
      , lookupSymbolOrScriptError
      , lookupSymbolOrScriptErrorDef
      , lookupSymbolListOrScriptError
      , lookupSymbolListOrScriptErrorDef
      , testNGLessIO
      ) where
  
  import qualified Data.Text as T
  import           Control.Monad.Except
  
  import Language
  import NGLess.NGError
  import Utils.Suggestion (suggestionMessage)
  
  type KwArgsValues = [(T.Text, NGLessObject)]
  
  
  boolOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m Bool
  boolOrTypeError _ (NGOBool b) = return b
  boolOrTypeError context val = throwScriptError ("Expected a boolean (received " ++ show val ++  ") in context '" ++ context ++ "'")
  
  -- | If argument is a NGOBool, then unwraps it; else it raises a type error
  symbolOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m T.Text
  symbolOrTypeError _ (NGOSymbol s) = return s
  symbolOrTypeError context val = throwScriptError ("Expected a symbol (received " ++ show val ++ ") in context '" ++ context ++ "'")
  
  -- | If argument is a NGOString, then unwraps it; else it raises a type error
  stringOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m T.Text
  stringOrTypeError _ (NGOString s) = return s
  stringOrTypeError _ (NGOFilename s) = return (T.pack s)
  stringOrTypeError context val = throwScriptError ("Expected a string (received " ++ show val ++ ") in context '" ++ context ++ "'")
  
  -- | If argument represents a file, then return it; otherwise, raise an error
  filepathOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m FilePath
  filepathOrTypeError _ (NGOString s) = return (T.unpack s)
  filepathOrTypeError _ (NGOFilename s) = return s
  filepathOrTypeError _ (NGOSequenceSet fp) = return fp
  filepathOrTypeError context val = throwScriptError ("Expected a filepath (received " ++ show val ++ ") in context '" ++ context ++ "'")
  
  
  -- | If argument is an NGOInteger, then unwraps it; else it raises a type error
  integerOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m Integer
  integerOrTypeError _ (NGOInteger i) = return i
  integerOrTypeError context val = throwScriptError ("Expected an integer (received " ++ show val ++ ") in context '" ++ context ++ "'")
  
  lookupStringOrScriptErrorDef :: (MonadError NGError m) => m T.Text -> String -> T.Text -> KwArgsValues -> m T.Text
  lookupStringOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just (NGOString s) -> return s
      Just other -> throwScriptError ("Expected a string in argument " ++ T.unpack name ++ " in context '" ++ context ++ "' instead observed: " ++ show other)
  
  lookupStringOrScriptError :: (MonadError NGError m) => String-> T.Text -> KwArgsValues -> m T.Text
  lookupStringOrScriptError = requiredLookup lookupStringOrScriptErrorDef
  
  lookupStringListOrScriptErrorDef :: (MonadError NGError m) => m [T.Text] -> String -> T.Text -> KwArgsValues -> m [T.Text]
  lookupStringListOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just (NGOList ss) -> stringOrTypeError context `mapM` ss
      Just other -> throwScriptError ("Expected a string in argument " ++ T.unpack name ++ " in context '" ++ context ++ "', instead saw " ++ show other)
  
  lookupStringListOrScriptError :: (MonadError NGError m) => String -> T.Text -> KwArgsValues -> m [T.Text]
  lookupStringListOrScriptError = requiredLookup lookupStringListOrScriptErrorDef
  
  
  lookupBoolOrScriptError :: (MonadError NGError m) => String-> T.Text -> KwArgsValues -> m Bool
  lookupBoolOrScriptError = requiredLookup lookupBoolOrScriptErrorDef
  
  lookupBoolOrScriptErrorDef :: (MonadError NGError m) => m Bool -> String -> T.Text -> KwArgsValues -> m Bool
  lookupBoolOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just v -> boolOrTypeError context v
  
  lookupIntegerOrScriptError :: (MonadError NGError m) => String-> T.Text -> KwArgsValues -> m Integer
  lookupIntegerOrScriptError = requiredLookup lookupIntegerOrScriptErrorDef
  lookupIntegerOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just (NGOInteger v) -> return v
      Just other -> throwScriptError ("Expected an integer in argument " ++ T.unpack name ++ " in context '" ++ context ++ "' instead observed: " ++ show other)
  
  lookupDoubleOrScriptError :: (MonadError NGError m) => String-> T.Text -> KwArgsValues -> m Double
  lookupDoubleOrScriptError = requiredLookup lookupDoubleOrScriptErrorDef
  lookupDoubleOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just (NGODouble v) -> return v
      Just other -> throwScriptError ("Expected a double in argument " ++ T.unpack name ++ " in context '" ++ context ++ "' instead observed: " ++ show other)
  
  lookupSymbolOrScriptError :: (MonadError NGError m) => String-> T.Text -> KwArgsValues -> m T.Text
  lookupSymbolOrScriptError = requiredLookup lookupSymbolOrScriptErrorDef
  lookupSymbolOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just (NGOSymbol s) -> return s
      Just other -> throwScriptError ("Expected a symbol in argument " ++ T.unpack name ++ " in context '" ++ context ++ "' instead observed: " ++ show other)
  
  
  lookupSymbolListOrScriptErrorDef :: (MonadError NGError m) => m [T.Text] -> String -> T.Text -> KwArgsValues -> m [T.Text]
  lookupSymbolListOrScriptErrorDef defval context name args = case lookup name args of
      Nothing -> defval
      Just (NGOList ss) -> symbolOrTypeError context `mapM` ss
      Just other -> throwScriptError ("Expected a symbol in argument " ++ T.unpack name ++ " in context '" ++ context ++ "', instead saw " ++ show other)
  
  lookupSymbolListOrScriptError :: (MonadError NGError m) => String -> T.Text -> KwArgsValues -> m [T.Text]
  lookupSymbolListOrScriptError = requiredLookup lookupSymbolListOrScriptErrorDef
  
  decodeSymbolOrError :: (MonadError NGError m) => String-> [(T.Text, a)] -> T.Text -> m a
  decodeSymbolOrError context allowed used = case lookup used allowed of
      Just v -> return v
      Nothing -> throwScriptError ("Invalid symbol value in context "
                                              ++context++".\n"
                                              ++T.unpack (suggestionMessage used (fst <$> allowed))
                                              ++"\nValid values are:"
                                              ++concat ["\n\t - "++T.unpack val | (val,_) <- allowed])
  
  
  requiredLookup :: (MonadError NGError m) => (m a -> String-> T.Text -> KwArgsValues -> m a) -> String-> T.Text -> KwArgsValues -> m a
  requiredLookup withDefaultLookup context name = withDefaultLookup errorAct context name
      where
          errorAct = throwScriptError ("Could not find '" ++ T.unpack name ++ " arguments (in context '" ++ context ++ "')")
  
  