{-# LANGUAGE CPP                 #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Yaml.TH
  ( -- * Decoding
    yamlQQ
#if MIN_VERSION_template_haskell(2,9,0)
  , decodeFile
#endif
    -- * Re-exports from "Data.Yaml"
  , Value (..)
  , Parser
  , Object
  , Array
  , object
  , array
  , (.=)
  , (.:)
  , (.:?)
  , (.!=)
  , FromJSON (..)
  ) where

import           Data.Text.Encoding
import qualified Data.Text as T
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax
import           Language.Haskell.TH.Quote

import           Data.Yaml hiding (decodeFile)

-- | Decode a YAML file at compile time. Only available on GHC version @7.8.1@
-- or higher.
--
-- @since 0.8.19.0
--
-- ==== __Examples__
--
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
--
-- config :: Config
-- config = $$('decodeFile' "config.yaml")
-- @
decodeFile :: forall a. (Lift a, FromJSON a) => FilePath -> Q (TExp a)
decodeFile :: forall a. (Lift a, FromJSON a) => FilePath -> Q (TExp a)
decodeFile FilePath
path = do
  FilePath -> Q ()
addDependentFile FilePath
path
  a
x <- IO a -> Q a
forall a. IO a -> Q a
runIO (IO a -> Q a) -> IO a -> Q a
forall a b. (a -> b) -> a -> b
$ FilePath -> IO a
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
decodeFileThrow FilePath
path
  (Exp -> TExp a) -> Q Exp -> Q (TExp a)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp a
forall a. Exp -> TExp a
TExp (a -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => a -> m Exp
lift (a
x :: a))

yamlExp :: String -> Q Exp
yamlExp :: FilePath -> Q Exp
yamlExp FilePath
input = do
  Value
val <- IO Value -> Q Value
forall a. IO a -> Q a
runIO (IO Value -> Q Value) -> IO Value -> Q Value
forall a b. (a -> b) -> a -> b
$ ByteString -> IO Value
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow (ByteString -> IO Value) -> ByteString -> IO Value
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
input
  Value -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Value -> m Exp
lift (Value
val :: Value)

-- | A @QuasiQuoter@ for YAML.
--
-- @since 0.8.28.0
--
-- ==== __Examples__
--
-- @
-- {-\# LANGUAGE QuasiQuotes \#-}
-- import Data.Yaml.TH
--
-- value :: Value
-- value = [yamlQQ|
-- name: John Doe
-- age: 23
-- |]
-- @
yamlQQ :: QuasiQuoter
yamlQQ :: QuasiQuoter
yamlQQ = QuasiQuoter {
  quoteExp :: FilePath -> Q Exp
quoteExp  = FilePath -> Q Exp
yamlExp
, quotePat :: FilePath -> Q Pat
quotePat  = FilePath -> FilePath -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => FilePath -> p -> m a
notDefined FilePath
"quotePat"
, quoteType :: FilePath -> Q Type
quoteType = FilePath -> FilePath -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => FilePath -> p -> m a
notDefined FilePath
"quoteType"
, quoteDec :: FilePath -> Q [Dec]
quoteDec  = FilePath -> FilePath -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => FilePath -> p -> m a
notDefined FilePath
"quoteDec"
} where
    notDefined :: FilePath -> p -> m a
notDefined FilePath
name p
_ = FilePath -> m a
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is not defined for yamlQQ")