{-# 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 :: forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile Path r File
p = 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 :: forall a r. HasCodec a => [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
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
(Path r File
p : [Path r File]
ps) -> do
Maybe ByteString
mc <- forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile forall a b. (a -> b) -> a -> b
$ 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 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",
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: " forall a. Semigroup a => a -> a -> a
<> forall b t. Path b t -> FilePath
toFilePath Path r File
f]
[Path r File]
fs -> FilePath
"While parsing files:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"* " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath) [Path r File]
fs
referenceMsgs :: [FilePath]
referenceMsgs =
[ FilePath
"Reference: ",
Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. HasCodec a => Text
renderColouredSchemaViaCodec @a
]
forall a. FilePath -> IO a
die forall a b. (a -> b) -> a -> b
$
[FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [FilePath]
failedMsgs,
[FilePath]
triedFilesMsgs,
[FilePath]
referenceMsgs
]
Right (Autodocodec a
conf) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
conf