@@ -2,13 +2,15 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE MultiParamTypeClasses #-}
44{-# LANGUAGE DeriveDataTypeable #-}
5+{-# LANGUAGE TypeSynonymInstances #-}
56module Data.Object.Yaml
67 ( -- * The event stream
78 Event (..)
89 , Style (..)
910 , Tag (..)
1011 -- * 'YamlObject' definition
11− , Yaml (..)
12+ , YamlDoc (..)
13+ , YamlScalar (..)
1214 , YamlObject
1315 -- * Performing conversions
1416 , eventsToYamlObject
@@ -89,33 +91,35 @@ instance ConvertSuccess [Char] Tag where
8991 convertSuccess "" = NoTag
9092 convertSuccess s = UriTag s
9193
92−data Yaml = Yaml
94+newtype YamlDoc = YamlDoc { unYamlDoc :: ByteString }
95+
96+data YamlScalar = YamlScalar
9397 { value :: ByteString
9498 , tag :: Tag
9599 , style :: Style
96100 }
97101 deriving (Show, Eq)
98−instance ConvertSuccess Yaml Event where
99− convertSuccess (Yaml v t s) = EventScalar v (convertSuccess t) s
102+instance ConvertSuccess YamlScalar Event where
103+ convertSuccess (YamlScalar v t s) = EventScalar v (convertSuccess t) s
100104
101−instance ConvertSuccess Yaml [Char] where
105+instance ConvertSuccess YamlScalar [Char] where
102106 convertSuccess = convertSuccess . value
103−instance ConvertSuccess [Char] Yaml where
104− convertSuccess t = Yaml (convertSuccess t) NoTag Any
107+instance ConvertSuccess [Char] YamlScalar where
108+ convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
105109
106−instance ConvertSuccess Yaml Text where
110+instance ConvertSuccess YamlScalar Text where
107111 convertSuccess = convertSuccess . value
108−instance ConvertSuccess Text Yaml where
109− convertSuccess t = Yaml (convertSuccess t) NoTag Any
112+instance ConvertSuccess Text YamlScalar where
113+ convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
110114
111115-- FIXME the following are incredibly stupid conversions which ignore tag
112116-- and style information.
113−instance ConvertSuccess Yaml Scalar where
117+instance ConvertSuccess YamlScalar Scalar where
114118 convertSuccess = Text . convertSuccess
115−instance ConvertSuccess Scalar Yaml where
119+instance ConvertSuccess Scalar YamlScalar where
116120 convertSuccess s = convertSuccess (convertSuccess s :: Text)
117121
118−type YamlObject = Object Yaml Yaml
122+type YamlObject = Object YamlScalar YamlScalar
119123
120124data YamlException =
121125 YamlParserException
@@ -134,7 +138,7 @@ data YamlException =
134138instance Exception YamlException
135139
136140-- Emit a YamlObject to an event stream
137−instance ConvertSuccess (Object Yaml Yaml) [Event] where
141+instance ConvertSuccess YamlObject [Event] where
138142 convertSuccess o = EventStreamStart
139143 : EventDocumentStart
140144 : helper o [EventDocumentEnd, EventStreamEnd] where
@@ -146,7 +150,7 @@ instance ConvertSuccess (Object Yaml Yaml) [Event] where
146150 helper (Mapping pairs) rest =
147151 EventMappingStart
148152 : foldr ($) (EventMappingEnd : rest) (map helperPairs pairs)
149− helperPairs :: (Yaml, YamlObject) -> [Event] -> [Event]
153+ helperPairs :: (YamlScalar, YamlObject) -> [Event] -> [Event]
150154 helperPairs (k, v) rest = convertSuccess k : helper v rest
151155
152156-- Parse a YamlObject from an event stream
@@ -166,7 +170,7 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
166170 -> m (YamlObject, [Event])
167171 h2 [] = failure YamlPrematureEventStreamEnd
168172 h2 (EventScalar v t s:rest) =
169− return (Scalar $ Yaml v (convertSuccess t) s, rest)
173+ return (Scalar $ YamlScalar v (convertSuccess t) s, rest)
170174 h2 (EventSequenceStart:es) = do
171175 (yos, rest) <- readSeq id es
172176 return (Sequence yos, rest)
@@ -186,9 +190,9 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
186190 readSeq (f . ((:) next)) rest
187191
188192 readMap :: MonadFailure YamlException m
189− => ([(Yaml, YamlObject)] -> [(Yaml, YamlObject)])
193+ => ([(YamlScalar, YamlObject)] -> [(YamlScalar, YamlObject)])
190194 -> [Event]
191− -> m ([(Yaml, YamlObject)], [Event])
195+ -> m ([(YamlScalar, YamlObject)], [Event])
192196 readMap _ [] = failure YamlPrematureEventStreamEnd
193197 readMap f (EventMappingEnd:rest) = return (f [], rest)
194198 readMap f es = do
@@ -200,12 +204,12 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
200204 readMap (f . ((:) (key', val))) rest'
201205eventsToYamlObject e = failure $ YamlInvalidEventStreamBeginning e
202206
203−instance ConvertSuccess (Object Yaml Yaml) (Object Text Text) where
207+instance ConvertSuccess (Object YamlScalar YamlScalar) (Object Text Text) where
204208 convertSuccess = mapKeysValues convertSuccess convertSuccess
205−instance ConvertSuccess (Object Text Text) (Object Yaml Yaml) where
209+instance ConvertSuccess (Object Text Text) (Object YamlScalar YamlScalar) where
206210 convertSuccess = mapKeysValues convertSuccess convertSuccess
207211
208−instance ConvertSuccess (Object Yaml Yaml) (Object String Scalar) where
212+instance ConvertSuccess (Object YamlScalar YamlScalar) (Object String Scalar) where
209213 convertSuccess = mapKeysValues convertSuccess convertSuccess
210−instance ConvertSuccess (Object String Scalar) (Object Yaml Yaml) where
214+instance ConvertSuccess (Object String Scalar) (Object YamlScalar YamlScalar) where
211215 convertSuccess = mapKeysValues convertSuccess convertSuccess