{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
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.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON)
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

import           Control.Exception.Safe
import qualified Streamly.Prelude     as S
import           Streamly.Prelude (SerialT, MonadAsync)

eventsFromFile
    :: (MonadCatch m, MonadAsync m, MonadMask m)
    => FilePath
    -> SerialT m Event
eventsFromFile :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
FilePath -> SerialT m Event
eventsFromFile = forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
[FilePath] -> FilePath -> SerialT m Event
go []
  where
-- decodeFile :: (MonadCatch m, MonadAsync m, MonadMask m) => FilePath -> SerialT m Event
    go :: (MonadCatch m, MonadAsync m, MonadMask m) => [FilePath] -> FilePath -> SerialT m Event
    go :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
[FilePath] -> FilePath -> SerialT m Event
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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO ParseException
CyclicIncludes
        forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
FilePath -> SerialT m Event
Y.decodeFile FilePath
cfp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
(a -> Bool) -> t m a -> t m a
S.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Event]
irrelevantEvents) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
[FilePath] -> FilePath -> SerialT m Event
go (FilePath
cfp forall a. a -> [a] -> [a]
: [FilePath]
seen) FilePath
includeFile
                Event
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =>
SerialT IO Event
-> IO (Either ParseException ([Warning], Either FilePath a))
decodeHelper (forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
FilePath -> SerialT m Event
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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m 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 =>
SerialT IO Event -> IO (Either ParseException ([Warning], a))
decodeHelper_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
FilePath -> SerialT m Event
eventsFromFile