gdritter repos adnot / 07b3556
Fix some decoding bugs + add some new helpers Getty Ritter 2 years ago
2 changed file(s) with 28 addition(s) and 3 deletion(s). Collapse all Expand all
212212 Sum t as -> k t as
213213 _ -> Left ("Expected sum in " ++ n)
214214
215 withSumNamed :: String -> T.Text -> (Array -> Parser a) -> Value -> Parser a
216 withSumNamed n tag k val = case val of
217 Sum t as
218 | tag == t -> k as
219 | otherwise -> Left $ unwords
220 [ "Expected tag", T.unpack tag, "in", n, "but found", T.unpack t ]
221 _ -> Left ("Expected sum in " ++ n)
222
215223 withProduct :: String -> (Product -> Parser a) -> Value -> Parser a
216224 withProduct n k val = case val of
217225 Product ps -> k ps
229237
230238 withDouble :: String -> (Double -> Parser a) -> Value -> Parser a
231239 withDouble n k val = case val of
232 Double d -> k d
240 Double d -> k d
241 Integer i -> k (fromIntegral i)
233242 _ -> Left ("Expected double in " ++ n)
234243
235244 withSymbol :: String -> (T.Text -> Parser a) -> Value -> Parser a
241250 withString n k val = case val of
242251 String s -> k s
243252 _ -> Left ("Expected string in " ++ n)
253
254 (.:) :: FromAdnot a => Product -> T.Text -> Parser a
255 map .: key = case MS.lookup key map of
256 Just x -> parseAdnot x
257 Nothing -> Left ("Missing key " ++ show key)
258
259 (.:?) :: FromAdnot a => Product -> T.Text -> Parser (Maybe a)
260 map .:? key = case MS.lookup key map of
261 Just x -> Just <$> parseAdnot x
262 Nothing -> return Nothing
263
264 (.!=) :: Parser (Maybe a) -> a -> Parser a
265 c .!= r = fmap (maybe r id) c
244266
245267 class FromAdnot a where
246268 parseAdnot :: Value -> Parser a
55 import Control.Applicative((<|>))
66 import Data.Attoparsec.ByteString.Char8
77 import Data.ByteString (ByteString)
8 import qualified Data.ByteString.Char8 as BS
89 import qualified Data.Map as M
910 import qualified Data.Text as T
11 import qualified Data.Text.Encoding as T
1012 import qualified Data.Vector as V
1113
1214 import Data.Adnot.Type
1517 decodeValue = parseOnly pVal
1618 where pVal = ws *> (pSum <|> pProd <|> pList <|> pLit)
1719 pSum = Sum <$> (char '(' *> ws *> pIdent)
18 <*> (pValueList <* char ')')
20 <*> (pValueList <* ws <* char ')')
1921 pProd = Product . M.fromList
2022 <$> (char '{' *> pProdBody <* ws <* char '}')
2123 pProdBody = many' pPair
2325 pList = List <$> (char '[' *> pValueList <* ws <* char ']')
2426 pLit = Symbol <$> pIdent
2527 <|> String <$> pString
28 <|> Double <$> double
2629 <|> Integer <$> decimal
2730 pValueList = V.fromList <$> many' pVal
2831 pIdent = T.pack <$>
2932 ((:) <$> (letter_ascii <|> char '_')
3033 <*> many' (letter_ascii <|> digit <|> char '_'))
31 pString = T.pack <$> (char '"' *> manyTill pStrChar (char '"'))
34 pString = T.decodeUtf8 . BS.pack <$> (char '"' *> manyTill pStrChar (char '"'))
3235 pStrChar = '\n' <$ string "\\n"
3336 <|> '\t' <$ string "\\t"
3437 <|> '\r' <$ string "\\r"