git.iko.soy/typeable/yaml
on master help sign in
Add Data.Yaml.TH.yamlQQ
54e0162Simon Hengel
Data/Yaml/TH.hs+25−4
compare with master
unifiedsplit
@@ -1,10 +1,10 @@
1{-# LANGUAGE LambdaCase #-}
1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3−{-# LANGUAGE TemplateHaskell #-}
4
3
5module Data.Yaml.TH
4module Data.Yaml.TH
6 ( -- * Decoding
5 ( -- * Decoding
7 decodeFile
6 decodeFile
7+ , yamlQQ
8 -- * Re-exports from "Data.Yaml"
8 -- * Re-exports from "Data.Yaml"
9 , Value (..)
9 , Value (..)
10 , Parser
10 , Parser
@@ -19,9 +19,13 @@ module Data.Yaml.TH
19 , FromJSON (..)
19 , FromJSON (..)
20 ) where
20 ) where
21
21
22+import Data.Text.Encoding
23+import qualified Data.Text as T
24+import Language.Haskell.TH
25+import Language.Haskell.TH.Syntax
26+import Language.Haskell.TH.Quote
27+
22−import Data.Yaml hiding (decodeFile)
28+import Data.Yaml hiding (decodeFile)
23−import Language.Haskell.TH
24−import Language.Haskell.TH.Syntax
25
29
26-- | Decode a @yaml@ file at compile time. Only available on GHC version @7.8.1@
30-- | Decode a @yaml@ file at compile time. Only available on GHC version @7.8.1@
27-- or higher.
31-- or higher.
@@ -42,3 +46,20 @@ decodeFile path = do
42 runIO (decodeFileEither path) >>= \case
46 runIO (decodeFileEither path) >>= \case
43 Left err -> fail (prettyPrintParseException err)
47 Left err -> fail (prettyPrintParseException err)
44 Right x -> fmap TExp (lift (x :: a))
48 Right x -> fmap TExp (lift (x :: a))
49+
50+decodeValue :: String -> Either String Value
51+decodeValue = decodeEither . encodeUtf8 . T.pack
52+
53+yamlExp :: String -> Q Exp
54+yamlExp input = case decodeValue input of
55+ Left err -> fail err
56+ Right a -> lift a
57+
58+yamlQQ :: QuasiQuoter
59+yamlQQ = QuasiQuoter {
60+ quoteExp = yamlExp
61+, quotePat = notDefined "quotePat"
62+, quoteType = notDefined "quoteType"
63+, quoteDec = notDefined "quoteDec"
64+} where
65+ notDefined name _ = fail (name ++ " is not defined for yamlQQ")
test/Data/Yaml/THSpec.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE QuasiQuotes #-}
3+module Data.Yaml.THSpec (spec) where
4+
5+import Test.Hspec
6+import Data.Aeson
7+
8+import Data.Yaml.TH
9+
10+spec :: Spec
11+spec = do
12+ describe "yamlQQ" $ do
13+ it "parses yaml" $ do
14+ [yamlQQ|
15+ name: John Doe
16+ age: 23
17+ |] `shouldBe` object ["name" .= String "John Doe", "age" .= Number 23]