{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
module Hpack.Yaml (
decodeYaml
, module Data.Aeson.Config.FromValue
) where
import Data.Bifunctor
import Data.Yaml hiding (decodeFile, decodeFileWithWarnings)
import Data.Yaml.Include
import Data.Yaml.Internal (Warning(..))
import Data.Aeson.Config.FromValue
import Data.Aeson.Config.Parser (fromAesonPath, formatPath)
formatWarning :: FilePath -> Warning -> String
formatWarning :: FilePath -> Warning -> FilePath
formatWarning file :: FilePath
file = \ case
DuplicateKey path :: JSONPath
path -> FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": Duplicate field " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ JSONPath -> FilePath
formatPath (JSONPath -> JSONPath
fromAesonPath JSONPath
path)
decodeYaml :: FilePath -> IO (Either String ([String], Value))
decodeYaml :: FilePath -> IO (Either FilePath ([FilePath], Value))
decodeYaml file :: FilePath
file = do
Either ParseException ([Warning], Value)
result <- FilePath -> IO (Either ParseException ([Warning], Value))
forall a.
FromJSON a =>
FilePath -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings FilePath
file
Either FilePath ([FilePath], Value)
-> IO (Either FilePath ([FilePath], Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath ([FilePath], Value)
-> IO (Either FilePath ([FilePath], Value)))
-> Either FilePath ([FilePath], Value)
-> IO (Either FilePath ([FilePath], Value))
forall a b. (a -> b) -> a -> b
$ (ParseException -> Either FilePath ([FilePath], Value))
-> (([Warning], Value) -> Either FilePath ([FilePath], Value))
-> Either ParseException ([Warning], Value)
-> Either FilePath ([FilePath], Value)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Either FilePath ([FilePath], Value)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ([FilePath], Value))
-> (ParseException -> FilePath)
-> ParseException
-> Either FilePath ([FilePath], Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
errToString) (([FilePath], Value) -> Either FilePath ([FilePath], Value)
forall a b. b -> Either a b
Right (([FilePath], Value) -> Either FilePath ([FilePath], Value))
-> (([Warning], Value) -> ([FilePath], Value))
-> ([Warning], Value)
-> Either FilePath ([FilePath], Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Warning] -> [FilePath])
-> ([Warning], Value) -> ([FilePath], Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Warning -> FilePath) -> [Warning] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Warning -> FilePath) -> [Warning] -> [FilePath])
-> (Warning -> FilePath) -> [Warning] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Warning -> FilePath
formatWarning FilePath
file)) Either ParseException ([Warning], Value)
result
where
errToString :: ParseException -> FilePath
errToString err :: ParseException
err = FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ case ParseException
err of
AesonException e :: FilePath
e -> ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e
InvalidYaml (Just (YamlException s :: FilePath
s)) -> ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
InvalidYaml (Just (YamlParseException{..})) -> ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
yamlLine FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
yamlColumn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
yamlProblem FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
yamlContext
where YamlMark{..} = YamlMark
yamlProblemMark
_ -> ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseException -> FilePath
forall a. Show a => a -> FilePath
show ParseException
err