{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Autodocodec.Yaml.IO where
import Autodocodec
import Autodocodec.Yaml.Schema
import qualified Data.ByteString as SB
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import Path
import Path.IO
import System.Exit
readYamlConfigFile :: HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile :: Path r File -> IO (Maybe a)
readYamlConfigFile Path r File
p = [Path r File] -> IO (Maybe a)
forall a r. HasCodec a => [Path r File] -> IO (Maybe a)
readFirstYamlConfigFile [Path r File
p]
readFirstYamlConfigFile :: forall a r. HasCodec a => [Path r File] -> IO (Maybe a)
readFirstYamlConfigFile :: [Path r File] -> IO (Maybe a)
readFirstYamlConfigFile [Path r File]
files = [Path r File] -> IO (Maybe a)
go [Path r File]
files
where
go :: [Path r File] -> IO (Maybe a)
go :: [Path r File] -> IO (Maybe a)
go =
\case
[] -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
(Path r File
p : [Path r File]
ps) -> do
Maybe ByteString
mc <- IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path r File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path r File
p
case Maybe ByteString
mc of
Maybe ByteString
Nothing -> [Path r File] -> IO (Maybe a)
go [Path r File]
ps
Just ByteString
contents ->
case ByteString -> Either ParseException (Autodocodec a)
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' ByteString
contents of
Left ParseException
err -> do
let failedMsgs :: [FilePath]
failedMsgs =
[ FilePath
"Failed to parse yaml file",
Path r File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path r File
p,
FilePath
"with error:",
ParseException -> FilePath
Yaml.prettyPrintParseException ParseException
err
]
triedFilesMsgs :: [FilePath]
triedFilesMsgs = case [Path r File]
files of
[] -> []
[Path r File
f] -> [FilePath
"While parsing file: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Path r File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path r File
f]
[Path r File]
fs -> FilePath
"While parsing files:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (Path r File -> FilePath) -> [Path r File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"* " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Path r File -> FilePath) -> Path r File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path r File -> FilePath
forall b t. Path b t -> FilePath
toFilePath) [Path r File]
fs
referenceMsgs :: [FilePath]
referenceMsgs =
[ FilePath
"Reference: ",
Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ HasCodec a => Text
forall a. HasCodec a => Text
renderColouredSchemaViaCodec @a
]
FilePath -> IO (Maybe a)
forall a. FilePath -> IO a
die (FilePath -> IO (Maybe a)) -> FilePath -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$
[FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
[[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [FilePath]
failedMsgs,
[FilePath]
triedFilesMsgs,
[FilePath]
referenceMsgs
]
Right (Autodocodec a
conf) -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
conf