git.iko.soy/typeable/yaml
on master help sign in
Initial builder code
393dbb3Michael Snoyman
Data/Yaml/Builder.hsnew file+70
compare with master
unifiedsplit
@@ -0,0 +1,70 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+module Data.Yaml.Builder
3+ ( YamlBuilder (..)
4+ , ToYaml (..)
5+ , mapping
6+ , array
7+ , string
8+ , toByteString
9+ , writeYamlFile
10+ , (.=)
11+ ) where
12+
13+import Data.Conduit
14+import Data.ByteString (ByteString)
15+import qualified Data.ByteString.Lazy as L
16+import Text.Libyaml
17+import Data.Text (Text)
18+import Data.Text.Encoding (encodeUtf8)
19+import qualified Data.Conduit.List as CL
20+import System.IO.Unsafe (unsafePerformIO)
21+import Control.Arrow (second)
22+import qualified Data.ByteString.Char8 as S8
23+
24+(.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder)
25+k .= v = (k, toYaml v)
26+
27+newtype YamlBuilder = YamlBuilder { unYamlBuilder :: [Event] -> [Event] }
28+
29+class ToYaml a where
30+ toYaml :: a -> YamlBuilder
31+instance ToYaml YamlBuilder where
32+ toYaml = id
33+instance ToYaml a => ToYaml [(Text, a)] where
34+ toYaml = mapping . map (second toYaml)
35+instance ToYaml a => ToYaml [a] where
36+ toYaml = array . map toYaml
37+instance ToYaml Text where
38+ toYaml = string
39+instance ToYaml Int where
40+ toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) IntTag PlainNoTag Nothing:)
41+
42+mapping :: [(Text, YamlBuilder)] -> YamlBuilder
43+mapping pairs = YamlBuilder $ \rest ->
44+ EventMappingStart Nothing : foldr addPair (EventMappingEnd : rest) pairs
45+ where
46+ addPair (key, YamlBuilder value) after
47+ = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing
48+ : value after
49+
50+array :: [YamlBuilder] -> YamlBuilder
51+array bs =
52+ YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)
53+ where
54+ go (YamlBuilder b) rest = b rest
55+
56+string :: Text -> YamlBuilder
57+string t = YamlBuilder (EventScalar (encodeUtf8 t) StrTag PlainNoTag Nothing:)
58+
59+toEvents :: YamlBuilder -> [Event]
60+toEvents (YamlBuilder front) =
61+ EventStreamStart : EventDocumentStart : front [EventDocumentEnd, EventStreamEnd]
62+
63+toSource :: Monad m => YamlBuilder -> Source m Event
64+toSource = mapM_ yield . toEvents
65+
66+toByteString :: YamlBuilder -> ByteString
67+toByteString yb = unsafePerformIO $ runResourceT $ toSource yb $$ encode
68+
69+writeYamlFile :: FilePath -> YamlBuilder -> IO ()
70+writeYamlFile fp yb = runResourceT $ toSource yb $$ encodeFile fp
builder-test.hsnew file+24
@@ -0,0 +1,24 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Data.Yaml.Builder
3+import qualified Data.ByteString as S
4+import Data.Text (Text)
5+
6+asText :: Text -> Text
7+asText = id
8+
9+asInt :: Int -> Int
10+asInt = id
11+
12+main :: IO ()
13+main = do
14+ let yb = array
15+ [ mapping
16+ [ "name" .= asText "Alice"
17+ , "age" .= asInt 57
18+ ]
19+ , mapping
20+ [ "name" .= asText "Bob"
21+ , "age" .= asInt 23
22+ ]
23+ ]
24+ S.putStr $ toByteString yb