spirv-reflect-yaml-0.1: lib/Data/SpirV/Reflect/Yaml.hs

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
  { source   :: FilePath
  , position :: YAML.Pos
  , message  :: String
  }
  deriving (Show)

instance Exception YamlError

load :: MonadIO io => FilePath -> io Module
load file =
  liftIO (BSL.readFile file) >>= loadBytes file

loadBytes :: MonadIO io => FilePath -> BSL.ByteString -> io Module
loadBytes source bytes =
  case YAML.decode1 bytes >>= YAML.parseEither . rootP of
    Left (position, message) ->
      liftIO $ throwIO YamlError{..}
    Right res ->
      pure res

prettyYamlError :: MonadIO io => YamlError -> io String
prettyYamlError err = do
  bytes <- liftIO (BSL.readFile $ source err)
  pure $ prettyYamlErrorBytes err bytes

prettyYamlErrorBytes :: YamlError -> BSL.ByteString -> String
prettyYamlErrorBytes YamlError{..} bytes =
  YAML.prettyPosWithSource position bytes source ++ message