git.iko.soy/typeable/yaml
on master help sign in
Yaml -> YamlScalar, added YamlDoc
93ce9aeMichael Snoyman
Data/Object/Yaml.hs+26−22
compare with master
unifiedsplit
@@ -2,13 +2,15 @@
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveDataTypeable #-}
5+{-# LANGUAGE TypeSynonymInstances #-}
5module Data.Object.Yaml
6module Data.Object.Yaml
6 ( -- * The event stream
7 ( -- * The event stream
7 Event (..)
8 Event (..)
8 , Style (..)
9 , Style (..)
9 , Tag (..)
10 , Tag (..)
10 -- * 'YamlObject' definition
11 -- * 'YamlObject' definition
11− , Yaml (..)
12+ , YamlDoc (..)
13+ , YamlScalar (..)
12 , YamlObject
14 , YamlObject
13 -- * Performing conversions
15 -- * Performing conversions
14 , eventsToYamlObject
16 , eventsToYamlObject
@@ -89,33 +91,35 @@ instance ConvertSuccess [Char] Tag where
89 convertSuccess "" = NoTag
91 convertSuccess "" = NoTag
90 convertSuccess s = UriTag s
92 convertSuccess s = UriTag s
91
93
92−data Yaml = Yaml
94+newtype YamlDoc = YamlDoc { unYamlDoc :: ByteString }
95+
96+data YamlScalar = YamlScalar
93 { value :: ByteString
97 { value :: ByteString
94 , tag :: Tag
98 , tag :: Tag
95 , style :: Style
99 , style :: Style
96 }
100 }
97 deriving (Show, Eq)
101 deriving (Show, Eq)
98−instance ConvertSuccess Yaml Event where
102+instance ConvertSuccess YamlScalar Event where
99− convertSuccess (Yaml v t s) = EventScalar v (convertSuccess t) s
103+ convertSuccess (YamlScalar v t s) = EventScalar v (convertSuccess t) s
100
104
101−instance ConvertSuccess Yaml [Char] where
105+instance ConvertSuccess YamlScalar [Char] where
102 convertSuccess = convertSuccess . value
106 convertSuccess = convertSuccess . value
103−instance ConvertSuccess [Char] Yaml where
107+instance ConvertSuccess [Char] YamlScalar where
104− convertSuccess t = Yaml (convertSuccess t) NoTag Any
108+ convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
105
109
106−instance ConvertSuccess Yaml Text where
110+instance ConvertSuccess YamlScalar Text where
107 convertSuccess = convertSuccess . value
111 convertSuccess = convertSuccess . value
108−instance ConvertSuccess Text Yaml where
112+instance ConvertSuccess Text YamlScalar where
109− convertSuccess t = Yaml (convertSuccess t) NoTag Any
113+ convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
110
114
111-- FIXME the following are incredibly stupid conversions which ignore tag
115-- FIXME the following are incredibly stupid conversions which ignore tag
112-- and style information.
116-- and style information.
113−instance ConvertSuccess Yaml Scalar where
117+instance ConvertSuccess YamlScalar Scalar where
114 convertSuccess = Text . convertSuccess
118 convertSuccess = Text . convertSuccess
115−instance ConvertSuccess Scalar Yaml where
119+instance ConvertSuccess Scalar YamlScalar where
116 convertSuccess s = convertSuccess (convertSuccess s :: Text)
120 convertSuccess s = convertSuccess (convertSuccess s :: Text)
117
121
118−type YamlObject = Object Yaml Yaml
122+type YamlObject = Object YamlScalar YamlScalar
119
123
120data YamlException =
124data YamlException =
121 YamlParserException
125 YamlParserException
@@ -134,7 +138,7 @@ data YamlException =
134instance Exception YamlException
138instance Exception YamlException
135
139
136-- Emit a YamlObject to an event stream
140-- Emit a YamlObject to an event stream
137−instance ConvertSuccess (Object Yaml Yaml) [Event] where
141+instance ConvertSuccess YamlObject [Event] where
138 convertSuccess o = EventStreamStart
142 convertSuccess o = EventStreamStart
139 : EventDocumentStart
143 : EventDocumentStart
140 : helper o [EventDocumentEnd, EventStreamEnd] where
144 : helper o [EventDocumentEnd, EventStreamEnd] where
@@ -146,7 +150,7 @@ instance ConvertSuccess (Object Yaml Yaml) [Event] where
146 helper (Mapping pairs) rest =
150 helper (Mapping pairs) rest =
147 EventMappingStart
151 EventMappingStart
148 : foldr ($) (EventMappingEnd : rest) (map helperPairs pairs)
152 : foldr ($) (EventMappingEnd : rest) (map helperPairs pairs)
149− helperPairs :: (Yaml, YamlObject) -> [Event] -> [Event]
153+ helperPairs :: (YamlScalar, YamlObject) -> [Event] -> [Event]
150 helperPairs (k, v) rest = convertSuccess k : helper v rest
154 helperPairs (k, v) rest = convertSuccess k : helper v rest
151
155
152-- Parse a YamlObject from an event stream
156-- Parse a YamlObject from an event stream
@@ -166,7 +170,7 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
166 -> m (YamlObject, [Event])
170 -> m (YamlObject, [Event])
167 h2 [] = failure YamlPrematureEventStreamEnd
171 h2 [] = failure YamlPrematureEventStreamEnd
168 h2 (EventScalar v t s:rest) =
172 h2 (EventScalar v t s:rest) =
169− return (Scalar $ Yaml v (convertSuccess t) s, rest)
173+ return (Scalar $ YamlScalar v (convertSuccess t) s, rest)
170 h2 (EventSequenceStart:es) = do
174 h2 (EventSequenceStart:es) = do
171 (yos, rest) <- readSeq id es
175 (yos, rest) <- readSeq id es
172 return (Sequence yos, rest)
176 return (Sequence yos, rest)
@@ -186,9 +190,9 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
186 readSeq (f . ((:) next)) rest
190 readSeq (f . ((:) next)) rest
187
191
188 readMap :: MonadFailure YamlException m
192 readMap :: MonadFailure YamlException m
189− => ([(Yaml, YamlObject)] -> [(Yaml, YamlObject)])
193+ => ([(YamlScalar, YamlObject)] -> [(YamlScalar, YamlObject)])
190 -> [Event]
194 -> [Event]
191− -> m ([(Yaml, YamlObject)], [Event])
195+ -> m ([(YamlScalar, YamlObject)], [Event])
192 readMap _ [] = failure YamlPrematureEventStreamEnd
196 readMap _ [] = failure YamlPrematureEventStreamEnd
193 readMap f (EventMappingEnd:rest) = return (f [], rest)
197 readMap f (EventMappingEnd:rest) = return (f [], rest)
194 readMap f es = do
198 readMap f es = do
@@ -200,12 +204,12 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
200 readMap (f . ((:) (key', val))) rest'
204 readMap (f . ((:) (key', val))) rest'
201eventsToYamlObject e = failure $ YamlInvalidEventStreamBeginning e
205eventsToYamlObject e = failure $ YamlInvalidEventStreamBeginning e
202
206
203−instance ConvertSuccess (Object Yaml Yaml) (Object Text Text) where
207+instance ConvertSuccess (Object YamlScalar YamlScalar) (Object Text Text) where
204 convertSuccess = mapKeysValues convertSuccess convertSuccess
208 convertSuccess = mapKeysValues convertSuccess convertSuccess
205−instance ConvertSuccess (Object Text Text) (Object Yaml Yaml) where
209+instance ConvertSuccess (Object Text Text) (Object YamlScalar YamlScalar) where
206 convertSuccess = mapKeysValues convertSuccess convertSuccess
210 convertSuccess = mapKeysValues convertSuccess convertSuccess
207
211
208−instance ConvertSuccess (Object Yaml Yaml) (Object String Scalar) where
212+instance ConvertSuccess (Object YamlScalar YamlScalar) (Object String Scalar) where
209 convertSuccess = mapKeysValues convertSuccess convertSuccess
213 convertSuccess = mapKeysValues convertSuccess convertSuccess
210−instance ConvertSuccess (Object String Scalar) (Object Yaml Yaml) where
214+instance ConvertSuccess (Object String Scalar) (Object YamlScalar YamlScalar) where
211 convertSuccess = mapKeysValues convertSuccess convertSuccess
215 convertSuccess = mapKeysValues convertSuccess convertSuccess
Text/Yaml.hs+17
@@ -3,6 +3,8 @@
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE CPP #-}
4{-# LANGUAGE CPP #-}
5{-# LANGUAGE PackageImports #-}
5{-# LANGUAGE PackageImports #-}
6+{-# LANGUAGE TypeSynonymInstances #-}
7+{-# OPTIONS_GHC -fno-warn-orphans #-}
6---------------------------------------------------------
8---------------------------------------------------------
7--
9--
8-- Module : Text.Yaml
10-- Module : Text.Yaml
@@ -92,6 +94,11 @@ encodeYaml' = unsafePerformIO . join . encode'
92decodeYaml' :: MonadFailure YamlException m => ByteString -> m YamlObject
94decodeYaml' :: MonadFailure YamlException m => ByteString -> m YamlObject
93decodeYaml' = unsafePerformIO . decode'
95decodeYaml' = unsafePerformIO . decode'
94
96
97+instance ConvertSuccess YamlObject YamlDoc where
98+ convertSuccess = YamlDoc . encodeYaml'
99+instance ConvertAttempt YamlDoc YamlObject where
100+ convertAttempt = decodeYaml' . unYamlDoc
101+
95-- Convert to YamlObject conversions
102-- Convert to YamlObject conversions
96encodeYaml :: ConvertSuccess x YamlObject => x -> ByteString
103encodeYaml :: ConvertSuccess x YamlObject => x -> ByteString
97encodeYaml = encodeYaml' . convertSuccess
104encodeYaml = encodeYaml' . convertSuccess
@@ -118,6 +125,11 @@ encodeText' = encodeYaml
118decodeText' :: MonadFailure YamlException m => ByteString -> m TextObject
125decodeText' :: MonadFailure YamlException m => ByteString -> m TextObject
119decodeText' = decodeYamlSuccess
126decodeText' = decodeYamlSuccess
120
127
128+instance ConvertSuccess TextObject YamlDoc where
129+ convertSuccess = YamlDoc . encodeText'
130+instance ConvertAttempt YamlDoc TextObject where
131+ convertAttempt = decodeText' . unYamlDoc
132+
121-- TextObject conversions
133-- TextObject conversions
122encodeText :: ConvertSuccess x TextObject => x -> ByteString
134encodeText :: ConvertSuccess x TextObject => x -> ByteString
123encodeText = encodeText' . convertSuccess
135encodeText = encodeText' . convertSuccess
@@ -146,6 +158,11 @@ decodeScalar' :: MonadFailure YamlException m
146 -> m ScalarObject
158 -> m ScalarObject
147decodeScalar' = decodeYamlSuccess
159decodeScalar' = decodeYamlSuccess
148
160
161+instance ConvertSuccess ScalarObject YamlDoc where
162+ convertSuccess = YamlDoc . encodeScalar'
163+instance ConvertAttempt YamlDoc ScalarObject where
164+ convertAttempt = decodeScalar' . unYamlDoc
165+
149-- ScalarObject conversions
166-- ScalarObject conversions
150encodeScalar :: ConvertSuccess x ScalarObject => x -> ByteString
167encodeScalar :: ConvertSuccess x ScalarObject => x -> ByteString
151encodeScalar = encodeScalar' . convertSuccess
168encodeScalar = encodeScalar' . convertSuccess