{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
module Hpack.Yaml (
-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
-- other tools.  It is not meant for general use by end users.  The following
-- caveats apply:
--
-- * The API is undocumented, consult the source instead.
--
-- * The exposed types and functions primarily serve Hpack's own needs, not
-- that of a public API.  Breaking changes can happen as Hpack evolves.
--
-- As an Hpack user you either want to use the @hpack@ executable or a build
-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).

  decodeYaml
, decodeYamlWithParseError
, ParseException
, formatYamlParseError
, formatWarning
, module Data.Aeson.Config.FromValue
) where

import           Imports

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)

decodeYaml :: FilePath -> IO (Either String ([String], Value))
decodeYaml :: FilePath -> IO (Either FilePath ([FilePath], Value))
decodeYaml FilePath
file = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> ParseException -> FilePath
formatYamlParseError FilePath
file) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either ParseException ([FilePath], Value))
decodeYamlWithParseError FilePath
file

decodeYamlWithParseError :: FilePath -> IO (Either ParseException ([String], Value))
decodeYamlWithParseError :: FilePath -> IO (Either ParseException ([FilePath], Value))
decodeYamlWithParseError FilePath
file = do
  Either ParseException ([Warning], Value)
result <- forall a.
FromJSON a =>
FilePath -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings FilePath
file
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ FilePath -> Warning -> FilePath
formatWarning FilePath
file)) Either ParseException ([Warning], Value)
result

formatYamlParseError :: FilePath -> ParseException -> String
formatYamlParseError :: FilePath -> ParseException -> FilePath
formatYamlParseError FilePath
file ParseException
err = FilePath
file forall a. [a] -> [a] -> [a]
++ case ParseException
err of
  AesonException FilePath
e -> FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
e
  InvalidYaml (Just (YamlException FilePath
s)) -> FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
s
  InvalidYaml (Just (YamlParseException{FilePath
YamlMark
yamlProblem :: YamlException -> FilePath
yamlContext :: YamlException -> FilePath
yamlProblemMark :: YamlException -> YamlMark
yamlProblemMark :: YamlMark
yamlContext :: FilePath
yamlProblem :: FilePath
..})) -> FilePath
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
yamlLine forall a. [a] -> [a] -> [a]
++ FilePath
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
yamlColumn forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
yamlProblem forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath
yamlContext
    where YamlMark{Int
yamlIndex :: YamlMark -> Int
yamlLine :: YamlMark -> Int
yamlColumn :: YamlMark -> Int
yamlIndex :: Int
yamlColumn :: Int
yamlLine :: Int
..} = YamlMark
yamlProblemMark
  ParseException
_ -> FilePath
": " forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> FilePath
displayException ParseException
err

formatWarning :: FilePath -> Warning -> String
formatWarning :: FilePath -> Warning -> FilePath
formatWarning FilePath
file = \ case
  DuplicateKey JSONPath
path -> FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
": Duplicate field " forall a. [a] -> [a] -> [a]
++ JSONPath -> FilePath
formatPath (JSONPath -> JSONPath
fromAesonPath JSONPath
path)