{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
module Data.Yaml.Include (
  decodeFile
, decodeFileEither
, decodeFileWithWarnings
) where

#if !MIN_VERSION_directory(1, 2, 3)
import Control.Exception (handleJust)
import Control.Monad (guard)
import System.IO.Error (ioeGetFileName, ioeGetLocation, isDoesNotExistError)
#endif

import Control.Exception (throwIO)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (MonadResource)
import Data.Aeson (FromJSON)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Text (unpack)
import Data.Text.Encoding (decodeUtf8)
import System.Directory
import System.FilePath

import Data.Yaml.Internal (ParseException(..), Warning(..), decodeHelper_, decodeHelper)
import Text.Libyaml hiding (decodeFile)
import qualified Text.Libyaml as Y

eventsFromFile
    :: MonadResource m
    => FilePath
    -> ConduitM i Event m ()
eventsFromFile :: forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
eventsFromFile = forall (m :: * -> *) i.
MonadResource m =>
[FilePath] -> FilePath -> ConduitM i Event m ()
go []
  where
    go :: MonadResource m => [FilePath] -> FilePath -> ConduitM i Event m ()
    go :: forall (m :: * -> *) i.
MonadResource m =>
[FilePath] -> FilePath -> ConduitM i Event m ()
go [FilePath]
seen FilePath
fp = do
        FilePath
cfp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall {a}. a -> a
handleNotFound forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
fp
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
cfp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
seen) forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO ParseException
CyclicIncludes
        forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
Y.decodeFile FilePath
cfp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| do
            forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever forall a b. (a -> b) -> a -> b
$ \Event
event -> case Event
event of
                EventScalar ByteString
f (UriTag FilePath
"!include") Style
_ Anchor
_ -> do
                    let includeFile :: FilePath
includeFile = FilePath -> FilePath
takeDirectory FilePath
cfp FilePath -> FilePath -> FilePath
</> Text -> FilePath
unpack (ByteString -> Text
decodeUtf8 ByteString
f)
                    forall (m :: * -> *) i.
MonadResource m =>
[FilePath] -> FilePath -> ConduitM i Event m ()
go (FilePath
cfp forall a. a -> [a] -> [a]
: [FilePath]
seen) FilePath
includeFile forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Event]
irrelevantEvents)
                Event
_ -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
event

    irrelevantEvents :: [Event]
irrelevantEvents = [Event
EventStreamStart, Event
EventDocumentStart, Event
EventDocumentEnd, Event
EventStreamEnd]

#if !MIN_VERSION_directory(1, 2, 3)
    handleNotFound = handleJust
        (\e -> do
            guard (isDoesNotExistError e)
            guard (ioeGetLocation e == "canonicalizePath")
            ioeGetFileName e)
        (throwIO . YamlException . ("Yaml file not found: " ++))
#else
    handleNotFound :: a -> a
handleNotFound = forall {a}. a -> a
id
#endif

-- | Like `Data.Yaml.decodeFile` but with support for relative and absolute
-- includes.
--
-- The syntax for includes follows the form:
--
-- > somekey: !include ./somefile.yaml
decodeFile
    :: FromJSON a
    => FilePath
    -> IO (Maybe a)
decodeFile :: forall a. FromJSON a => FilePath -> IO (Maybe a)
decodeFile FilePath
fp = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
FromJSON a =>
ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], Either FilePath a))
decodeHelper (forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
eventsFromFile FilePath
fp)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall {a}. a -> a
id)

-- | Like `Data.Yaml.decodeFileEither` but with support for relative and
-- absolute includes.
--
-- The syntax for includes follows the form:
--
-- > somekey: !include ./somefile.yaml
decodeFileEither
    :: FromJSON a
    => FilePath
    -> IO (Either ParseException a)
decodeFileEither :: forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
FromJSON a =>
FilePath -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings

-- | A version of `decodeFileEither` that returns warnings along with the parse
-- result.
--
-- @since 0.10.0
decodeFileWithWarnings
    :: FromJSON a
    => FilePath
    -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings :: forall a.
FromJSON a =>
FilePath -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings = forall a.
FromJSON a =>
ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], a))
decodeHelper_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
eventsFromFile