module Data.SpirV.Reflect.Yaml
  ( load
  , loadBytes

  , YamlError(..)
  , prettyYamlError
  , prettyYamlErrorBytes
  ) where

import Control.Exception (Exception, throwIO)
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString.Lazy qualified as BSL
import Data.YAML qualified as YAML

import Data.SpirV.Reflect.Module (Module)
import Data.SpirV.Reflect.Yaml.Parsers (rootP)

data YamlError = YamlError
  { YamlError -> FilePath
source   :: FilePath
  , YamlError -> Pos
position :: YAML.Pos
  , YamlError -> FilePath
message  :: String
  }
  deriving (Int -> YamlError -> ShowS
[YamlError] -> ShowS
YamlError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [YamlError] -> ShowS
$cshowList :: [YamlError] -> ShowS
show :: YamlError -> FilePath
$cshow :: YamlError -> FilePath
showsPrec :: Int -> YamlError -> ShowS
$cshowsPrec :: Int -> YamlError -> ShowS
Show)

instance Exception YamlError

load :: MonadIO io => FilePath -> io Module
load :: forall (io :: * -> *). MonadIO io => FilePath -> io Module
load FilePath
file =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
BSL.readFile FilePath
file) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (io :: * -> *).
MonadIO io =>
FilePath -> ByteString -> io Module
loadBytes FilePath
file

loadBytes :: MonadIO io => FilePath -> BSL.ByteString -> io Module
loadBytes :: forall (io :: * -> *).
MonadIO io =>
FilePath -> ByteString -> io Module
loadBytes FilePath
source ByteString
bytes =
  case forall v. FromYAML v => ByteString -> Either (Pos, FilePath) v
YAML.decode1 ByteString
bytes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Parser a -> Either (Pos, FilePath) a
YAML.parseEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeParser Module
rootP of
    Left (Pos
position, FilePath
message) ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO YamlError{FilePath
Pos
message :: FilePath
position :: Pos
source :: FilePath
$sel:message:YamlError :: FilePath
$sel:position:YamlError :: Pos
$sel:source:YamlError :: FilePath
..}
    Right Module
res ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Module
res

prettyYamlError :: MonadIO io => YamlError -> io String
prettyYamlError :: forall (io :: * -> *). MonadIO io => YamlError -> io FilePath
prettyYamlError YamlError
err = do
  ByteString
bytes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
BSL.readFile forall a b. (a -> b) -> a -> b
$ YamlError -> FilePath
source YamlError
err)
  pure $ YamlError -> ByteString -> FilePath
prettyYamlErrorBytes YamlError
err ByteString
bytes

prettyYamlErrorBytes :: YamlError -> BSL.ByteString -> String
prettyYamlErrorBytes :: YamlError -> ByteString -> FilePath
prettyYamlErrorBytes YamlError{FilePath
Pos
message :: FilePath
position :: Pos
source :: FilePath
$sel:message:YamlError :: YamlError -> FilePath
$sel:position:YamlError :: YamlError -> Pos
$sel:source:YamlError :: YamlError -> FilePath
..} ByteString
bytes =
  Pos -> ByteString -> ShowS
YAML.prettyPosWithSource Pos
position ByteString
bytes FilePath
source forall a. [a] -> [a] -> [a]
++ FilePath
message