{-# 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 :: FilePath -> ConduitM i Event m ()
eventsFromFile = [FilePath] -> FilePath -> ConduitM i Event m ()
forall (m :: * -> *) i.
MonadResource m =>
[FilePath] -> FilePath -> ConduitM i Event m ()
go []
  where
    go :: MonadResource m => [FilePath] -> FilePath -> ConduitM i Event m ()
    go :: [FilePath] -> FilePath -> ConduitM i Event m ()
go [FilePath]
seen FilePath
fp = do
        FilePath
cfp <- IO FilePath -> ConduitT i Event m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ConduitT i Event m FilePath)
-> IO FilePath -> ConduitT i Event 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 -> ConduitM i Event m () -> ConduitM i Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
cfp FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
seen) (ConduitM i Event m () -> ConduitM i Event m ())
-> ConduitM i Event m () -> ConduitM i Event m ()
forall a b. (a -> b) -> a -> b
$ do
            IO () -> ConduitM i Event m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM i Event m ()) -> IO () -> ConduitM i Event m ()
forall a b. (a -> b) -> a -> b
$ ParseException -> IO ()
forall e a. Exception e => e -> IO a
throwIO ParseException
CyclicIncludes
        FilePath -> ConduitM i Event m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
Y.decodeFile FilePath
cfp ConduitM i Event m ()
-> ConduitM Event Event m () -> ConduitM i Event m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| do
            (Event -> ConduitM Event Event m ()) -> ConduitM Event Event m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((Event -> ConduitM Event Event m ()) -> ConduitM Event Event m ())
-> (Event -> ConduitM Event Event m ())
-> ConduitM Event Event m ()
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)
                    [FilePath] -> FilePath -> ConduitM Event Event m ()
forall (m :: * -> *) i.
MonadResource m =>
[FilePath] -> FilePath -> ConduitM i Event m ()
go (FilePath
cfp FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
seen) FilePath
includeFile ConduitM Event Event m ()
-> ConduitM Event Event m () -> ConduitM Event Event m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Event -> Bool) -> ConduitM Event Event m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter (Event -> [Event] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Event]
irrelevantEvents)
                Event
_ -> Event -> ConduitM Event Event m ()
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 = 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 :: 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 (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
<$> ConduitM () Event Parse ()
-> IO
     (Either ParseException ([Warning], Either FilePath (Maybe a)))
forall a.
FromJSON a =>
ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], Either FilePath a))
decodeHelper (FilePath -> ConduitM () Event Parse ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
eventsFromFile FilePath
fp)) IO (Either ParseException (Either FilePath (Maybe a)))
-> (Either ParseException (Either FilePath (Maybe a))
    -> IO (Maybe a))
-> IO (Maybe a)
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 e a. Exception e => e -> IO a
throwIO (Maybe a -> IO (Maybe 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 :: FilePath -> IO (Either ParseException a)
decodeFileEither = (Either ParseException ([Warning], a) -> Either ParseException a)
-> IO (Either ParseException ([Warning], a))
-> IO (Either ParseException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Warning], a) -> a)
-> Either ParseException ([Warning], a) -> Either ParseException a
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 :: FilePath -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings = ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], a))
forall a.
FromJSON a =>
ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], a))
decodeHelper_ (ConduitM () Event Parse ()
 -> IO (Either ParseException ([Warning], a)))
-> (FilePath -> ConduitM () Event Parse ())
-> FilePath
-> IO (Either ParseException ([Warning], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ConduitM () Event Parse ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitM i Event m ()
eventsFromFile