@@ -1,10 +1,13 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE LambdaCase #-}
23{-# LANGUAGE ScopedTypeVariables #-}
3−{-# LANGUAGE TemplateHaskell #-}
44
55module Data.Yaml.TH
66 ( -- * Decoding
7− decodeFile
7+ yamlQQ
8+#if MIN_VERSION_template_haskell(2,9,0)
9+ , decodeFile
10+#endif
811 -- * Re-exports from "Data.Yaml"
912 , Value (..)
1013 , Parser
@@ -19,11 +22,16 @@ module Data.Yaml.TH
1922 , FromJSON (..)
2023 ) where
2124
22−import Data.Yaml hiding (decodeFile)
23−import Language.Haskell.TH
24−import Language.Haskell.TH.Syntax
25+import Data.Text.Encoding
26+import qualified Data.Text as T
27+import Language.Haskell.TH
28+import Language.Haskell.TH.Syntax
29+import Language.Haskell.TH.Quote
2530
26−-- | Decode a @yaml@ file at compile time. Only available on GHC version @7.8.1@
31+import Data.Yaml hiding (decodeFile)
32+
33+#if MIN_VERSION_template_haskell(2,9,0)
34+-- | Decode a YAML file at compile time. Only available on GHC version @7.8.1@
2735-- or higher.
2836--
2937-- @since 0.8.19.0
@@ -42,3 +50,37 @@ decodeFile path = do
4250 runIO (decodeFileEither path) >>= \case
4351 Left err -> fail (prettyPrintParseException err)
4452 Right x -> fmap TExp (lift (x :: a))
53+#endif
54+
55+decodeValue :: String -> Either String Value
56+decodeValue = decodeEither . encodeUtf8 . T.pack
57+
58+yamlExp :: String -> Q Exp
59+yamlExp input = case decodeValue input of
60+ Left err -> fail err
61+ Right a -> lift a
62+
63+-- | A @QuasiQuoter@ for YAML.
64+--
65+-- @since 0.8.28.0
66+--
67+-- ==== __Examples__
68+--
69+-- @
70+-- {-\# LANGUAGE QuasiQuotes \#-}
71+-- import Data.Yaml.TH
72+--
73+-- value :: Value
74+-- value = [yamlQQ|
75+-- name: John Doe
76+-- age: 23
77+-- |]
78+-- @
79+yamlQQ :: QuasiQuoter
80+yamlQQ = QuasiQuoter {
81+ quoteExp = yamlExp
82+, quotePat = notDefined "quotePat"
83+, quoteType = notDefined "quoteType"
84+, quoteDec = notDefined "quoteDec"
85+} where
86+ notDefined name _ = fail (name ++ " is not defined for yamlQQ")