{-# 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 (MonadIO(..))
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 Streamly.Data.Stream (Stream)
import Streamly.Data.StreamK (StreamK)
import qualified Streamly.Data.StreamK as K
import qualified Streamly.Data.Stream as S

eventsFromFile
    :: (MonadCatch m, MonadIO m, MonadMask m)
    => FilePath
    -> Stream m Event
eventsFromFile :: forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
FilePath -> Stream m Event
eventsFromFile = StreamK m Event -> Stream m Event
forall (m :: * -> *) a. Applicative m => StreamK m a -> Stream m a
K.toStream (StreamK m Event -> Stream m Event)
-> (FilePath -> StreamK m Event) -> FilePath -> Stream m Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath -> StreamK m Event
forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
[FilePath] -> FilePath -> StreamK m Event
go []
  where

    go :: (MonadCatch m, MonadIO m, MonadMask m) => [FilePath] -> FilePath -> StreamK m Event
    go :: forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
[FilePath] -> FilePath -> StreamK m Event
go [FilePath]
seen FilePath
fp = m (StreamK m Event) -> StreamK m Event
forall (m :: * -> *) a. Monad m => m (StreamK m a) -> StreamK m a
K.concatEffect (m (StreamK m Event) -> StreamK m Event)
-> m (StreamK m Event) -> StreamK m Event
forall a b. (a -> b) -> a -> b
$ do
        FilePath
cfp <- IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ IO FilePath -> IO FilePath
forall {a}. a -> a
handleNotFound (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
fp
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
cfp FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
seen) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ParseException -> m ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwIO ParseException
CyclicIncludes
        StreamK m Event -> m (StreamK m Event)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StreamK m Event -> m (StreamK m Event))
-> StreamK m Event -> m (StreamK m Event)
forall a b. (a -> b) -> a -> b
$ (StreamK m Event -> StreamK m Event -> StreamK m Event)
-> (Event -> StreamK m Event) -> StreamK m Event -> StreamK m Event
forall (m :: * -> *) b a.
(StreamK m b -> StreamK m b -> StreamK m b)
-> (a -> StreamK m b) -> StreamK m a -> StreamK m b
K.concatMapWith StreamK m Event -> StreamK m Event -> StreamK m Event
forall (m :: * -> *) a. StreamK m a -> StreamK m a -> StreamK m a
K.append ([FilePath] -> FilePath -> Event -> StreamK m Event
forall {m :: * -> *}.
(MonadIO m, MonadMask m) =>
[FilePath] -> FilePath -> Event -> StreamK m Event
go1 [FilePath]
seen FilePath
cfp) (Stream m Event -> StreamK m Event
forall (m :: * -> *) a. Monad m => Stream m a -> StreamK m a
K.fromStream (FilePath -> Stream m Event
forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
FilePath -> Stream m Event
Y.decodeFile FilePath
cfp))

    go1 :: [FilePath] -> FilePath -> Event -> StreamK m Event
go1 [FilePath]
seen FilePath
cfp Event
event =
        case Event
event of
            EventScalar ByteString
f (UriTag FilePath
"!include") Style
_ Anchor
_ ->
                let includeFile :: FilePath
includeFile =
                        FilePath -> FilePath
takeDirectory FilePath
cfp FilePath -> FilePath -> FilePath
</> Text -> FilePath
unpack (ByteString -> Text
decodeUtf8 ByteString
f)
                in Stream m Event -> StreamK m Event
forall (m :: * -> *) a. Monad m => Stream m a -> StreamK m a
K.fromStream
                       (Stream m Event -> StreamK m Event)
-> Stream m Event -> StreamK m Event
forall a b. (a -> b) -> a -> b
$ (Event -> Bool) -> Stream m Event -> Stream m Event
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Stream m a -> Stream m a
S.filter (Event -> [Event] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Event]
irrelevantEvents)
                       (Stream m Event -> Stream m Event)
-> Stream m Event -> Stream m Event
forall a b. (a -> b) -> a -> b
$ StreamK m Event -> Stream m Event
forall (m :: * -> *) a. Applicative m => StreamK m a -> Stream m a
K.toStream
                       (StreamK m Event -> Stream m Event)
-> StreamK m Event -> Stream m Event
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> StreamK m Event
forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
[FilePath] -> FilePath -> StreamK m Event
go (FilePath
cfp FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
seen) FilePath
includeFile
            Event
_ -> Event -> StreamK m Event
forall a (m :: * -> *). a -> StreamK m a
K.fromPure 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 = a -> a
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 = ((([Warning], Either FilePath (Maybe a))
 -> Either FilePath (Maybe a))
-> Either ParseException ([Warning], Either FilePath (Maybe a))
-> Either ParseException (Either FilePath (Maybe a))
forall a b.
(a -> b) -> Either ParseException a -> Either ParseException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Warning], Either FilePath (Maybe a)) -> Either FilePath (Maybe a)
forall a b. (a, b) -> b
snd (Either ParseException ([Warning], Either FilePath (Maybe a))
 -> Either ParseException (Either FilePath (Maybe a)))
-> IO
     (Either ParseException ([Warning], Either FilePath (Maybe a)))
-> IO (Either ParseException (Either FilePath (Maybe a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream IO Event
-> IO
     (Either ParseException ([Warning], Either FilePath (Maybe a)))
forall a.
FromJSON a =>
Stream IO Event
-> IO (Either ParseException ([Warning], Either FilePath a))
decodeHelper (FilePath -> Stream IO Event
forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
FilePath -> Stream m Event
eventsFromFile FilePath
fp)) IO (Either ParseException (Either FilePath (Maybe a)))
-> (Either ParseException (Either FilePath (Maybe a))
    -> IO (Maybe a))
-> IO (Maybe a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseException -> IO (Maybe a))
-> (Either FilePath (Maybe a) -> IO (Maybe a))
-> Either ParseException (Either FilePath (Maybe a))
-> IO (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> IO (Maybe a)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwIO (Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a))
-> (Either FilePath (Maybe a) -> Maybe a)
-> Either FilePath (Maybe a)
-> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe a)
-> (Maybe a -> Maybe a) -> Either FilePath (Maybe a) -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> FilePath -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) Maybe a -> Maybe a
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 = (Either ParseException ([Warning], a) -> Either ParseException a)
-> IO (Either ParseException ([Warning], a))
-> IO (Either ParseException a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Warning], a) -> a)
-> Either ParseException ([Warning], a) -> Either ParseException a
forall a b.
(a -> b) -> Either ParseException a -> Either ParseException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Warning], a) -> a
forall a b. (a, b) -> b
snd) (IO (Either ParseException ([Warning], a))
 -> IO (Either ParseException a))
-> (FilePath -> IO (Either ParseException ([Warning], a)))
-> FilePath
-> IO (Either ParseException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Either ParseException ([Warning], a))
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 = Stream IO Event -> IO (Either ParseException ([Warning], a))
forall a.
FromJSON a =>
Stream IO Event -> IO (Either ParseException ([Warning], a))
decodeHelper_ (Stream IO Event -> IO (Either ParseException ([Warning], a)))
-> (FilePath -> Stream IO Event)
-> FilePath
-> IO (Either ParseException ([Warning], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Stream IO Event
forall (m :: * -> *).
(MonadCatch m, MonadIO m, MonadMask m) =>
FilePath -> Stream m Event
eventsFromFile