1{-# LANGUAGE CPP                 #-}
2{-# LANGUAGE LambdaCase          #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4
5module Data.Yaml.TH
6  ( -- * Decoding
7    yamlQQ
8#if MIN_VERSION_template_haskell(2,9,0)
9  , decodeFile
10#endif
11    -- * Re-exports from "Data.Yaml"
12  , Value (..)
13  , Parser
14  , Object
15  , Array
16  , object
17  , array
18  , (.=)
19  , (.:)
20  , (.:?)
21  , (.!=)
22  , FromJSON (..)
23  ) where
24
25import           Data.Text.Encoding
26import qualified Data.Text as T
27import           Language.Haskell.TH
28import           Language.Haskell.TH.Syntax
29import           Language.Haskell.TH.Quote
30
31import           Data.Yaml hiding (decodeFile)
32
33-- | Decode a YAML file at compile time. Only available on GHC version @7.8.1@
34-- or higher.
35--
36-- @since 0.8.19.0
37--
38-- ==== __Examples__
39--
40-- @
41-- {-\# LANGUAGE TemplateHaskell \#-}
42--
43-- config :: Config
44-- config = $$('decodeFile' "config.yaml")
45-- @
46decodeFile :: forall a. (Lift a, FromJSON a) => FilePath -> Q (TExp a)
47decodeFile path = do
48  addDependentFile path
49  x <- runIO $ decodeFileThrow path
50  fmap TExp (lift (x :: a))
51
52yamlExp :: String -> Q Exp
53yamlExp input = do
54  val <- runIO $ decodeThrow $ encodeUtf8 $ T.pack input
55  lift (val :: Value)
56
57-- | A @QuasiQuoter@ for YAML.
58--
59-- @since 0.8.28.0
60--
61-- ==== __Examples__
62--
63-- @
64-- {-\# LANGUAGE QuasiQuotes \#-}
65-- import Data.Yaml.TH
66--
67-- value :: Value
68-- value = [yamlQQ|
69-- name: John Doe
70-- age: 23
71-- |]
72-- @
73yamlQQ :: QuasiQuoter
74yamlQQ = QuasiQuoter {
75  quoteExp  = yamlExp
76, quotePat  = notDefined "quotePat"
77, quoteType = notDefined "quoteType"
78, quoteDec  = notDefined "quoteDec"
79} where
80    notDefined name _ = fail (name ++ " is not defined for yamlQQ")
81