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
(Int -> YamlError -> ShowS)
-> (YamlError -> FilePath)
-> ([YamlError] -> ShowS)
-> Show YamlError
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 :: FilePath -> io Module
load FilePath
file =
  IO ByteString -> io ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
BSL.readFile FilePath
file) io ByteString -> (ByteString -> io Module) -> io Module
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> io Module
forall (io :: * -> *).
MonadIO io =>
FilePath -> ByteString -> io Module
loadBytes FilePath
file

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

prettyYamlError :: MonadIO io => YamlError -> io String
prettyYamlError :: YamlError -> io FilePath
prettyYamlError YamlError
err = do
  ByteString
bytes <- IO ByteString -> io ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
BSL.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
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 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
message