git.iko.soy/typeable/yaml
on 06f73cc help sign in
typeable/yaml/src/Data/Yaml/Include.hs
80 lines 2.6 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE RankNTypes #-}
3module Data.Yaml.Include (decodeFile, decodeFileEither) where
5#if !MIN_VERSION_directory(1, 2, 3)
6import Control.Exception (handleJust)
7import Control.Monad (guard)
8import System.IO.Error (ioeGetFileName, ioeGetLocation, isDoesNotExistError)
9#endif
11import Control.Exception (throwIO)
12import Control.Monad (when)
13import Control.Monad.IO.Class (liftIO)
14import Control.Monad.Trans.Resource (MonadResource)
15import Data.Aeson (FromJSON)
16import Data.Conduit
17import qualified Data.Conduit.List as CL
18import Data.Text (unpack)
19import Data.Text.Encoding (decodeUtf8)
20import System.Directory
21import System.FilePath
23import Data.Yaml.Internal (ParseException(..), decodeHelper_, decodeHelper)
24import Text.Libyaml hiding (decodeFile)
25import qualified Text.Libyaml as Y
27eventsFromFile
28 :: MonadResource m
29 => FilePath
30 -> ConduitM i Event m ()
31eventsFromFile = go []
32 where
33 go :: MonadResource m => [FilePath] -> FilePath -> ConduitM i Event m ()
34 go seen fp = do
35 cfp <- liftIO $ handleNotFound $ canonicalizePath fp
36 when (cfp `elem` seen) $ do
37 liftIO $ throwIO CyclicIncludes
38 Y.decodeFile cfp .| do
39 awaitForever $ \event -> case event of
40 EventScalar f (UriTag "!include") _ _ -> do
41 let includeFile = takeDirectory cfp </> unpack (decodeUtf8 f)
42 go (cfp : seen) includeFile .| CL.filter (`notElem` irrelevantEvents)
43 _ -> yield event
45 irrelevantEvents = [EventStreamStart, EventDocumentStart, EventDocumentEnd, EventStreamEnd]
47#if !MIN_VERSION_directory(1, 2, 3)
48 handleNotFound = handleJust
49 (\e -> do
50 guard (isDoesNotExistError e)
51 guard (ioeGetLocation e == "canonicalizePath")
52 ioeGetFileName e)
53 (throwIO . YamlException . ("Yaml file not found: " ++))
54#else
55 handleNotFound = id
56#endif
58-- | Like `Data.Yaml.decodeFile` but with support for relative and absolute
59-- includes.
60--
61-- The syntax for includes follows the form:
62--
63-- > somekey: !include ./somefile.yaml
64decodeFile
65 :: FromJSON a
66 => FilePath
67 -> IO (Maybe a)
68decodeFile fp = decodeHelper (eventsFromFile fp) >>= either throwIO (return . either (const Nothing) id)
70-- | Like `Data.Yaml.decodeFileEither` but with support for relative and
71-- absolute includes.
72--
73-- The syntax for includes follows the form:
74--
75-- > somekey: !include ./somefile.yaml
76decodeFileEither
77 :: FromJSON a
78 => FilePath
79 -> IO (Either ParseException a)
80decodeFileEither = decodeHelper_ . eventsFromFile