Fix some decoding bugs + add some new helpers
Getty Ritter
7 years ago
| 212 | 212 | Sum t as -> k t as |
| 213 | 213 | _ -> Left ("Expected sum in " ++ n) |
| 214 | 214 | |
| 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 | ||
| 215 | 223 | withProduct :: String -> (Product -> Parser a) -> Value -> Parser a |
| 216 | 224 | withProduct n k val = case val of |
| 217 | 225 | Product ps -> k ps |
| 229 | 237 | |
| 230 | 238 | withDouble :: String -> (Double -> Parser a) -> Value -> Parser a |
| 231 | 239 | withDouble n k val = case val of |
| 232 |
Double d |
|
| 240 | Double d -> k d | |
| 241 | Integer i -> k (fromIntegral i) | |
| 233 | 242 | _ -> Left ("Expected double in " ++ n) |
| 234 | 243 | |
| 235 | 244 | withSymbol :: String -> (T.Text -> Parser a) -> Value -> Parser a |
| 241 | 250 | withString n k val = case val of |
| 242 | 251 | String s -> k s |
| 243 | 252 | _ -> 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 | |
| 244 | 266 | |
| 245 | 267 | class FromAdnot a where |
| 246 | 268 | parseAdnot :: Value -> Parser a |
| 5 | 5 | import Control.Applicative((<|>)) |
| 6 | 6 | import Data.Attoparsec.ByteString.Char8 |
| 7 | 7 | import Data.ByteString (ByteString) |
| 8 | import qualified Data.ByteString.Char8 as BS | |
| 8 | 9 | import qualified Data.Map as M |
| 9 | 10 | import qualified Data.Text as T |
| 11 | import qualified Data.Text.Encoding as T | |
| 10 | 12 | import qualified Data.Vector as V |
| 11 | 13 | |
| 12 | 14 | import Data.Adnot.Type |
| 15 | 17 | decodeValue = parseOnly pVal |
| 16 | 18 | where pVal = ws *> (pSum <|> pProd <|> pList <|> pLit) |
| 17 | 19 | pSum = Sum <$> (char '(' *> ws *> pIdent) |
| 18 |
<*> (pValueList <* |
|
| 20 | <*> (pValueList <* ws <* char ')') | |
| 19 | 21 | pProd = Product . M.fromList |
| 20 | 22 | <$> (char '{' *> pProdBody <* ws <* char '}') |
| 21 | 23 | pProdBody = many' pPair |
| 23 | 25 | pList = List <$> (char '[' *> pValueList <* ws <* char ']') |
| 24 | 26 | pLit = Symbol <$> pIdent |
| 25 | 27 | <|> String <$> pString |
| 28 | <|> Double <$> double | |
| 26 | 29 | <|> Integer <$> decimal |
| 27 | 30 | pValueList = V.fromList <$> many' pVal |
| 28 | 31 | pIdent = T.pack <$> |
| 29 | 32 | ((:) <$> (letter_ascii <|> char '_') |
| 30 | 33 | <*> many' (letter_ascii <|> digit <|> char '_')) |
| 31 |
pString = T. |
|
| 34 | pString = T.decodeUtf8 . BS.pack <$> (char '"' *> manyTill pStrChar (char '"')) | |
| 32 | 35 | pStrChar = '\n' <$ string "\\n" |
| 33 | 36 | <|> '\t' <$ string "\\t" |
| 34 | 37 | <|> '\r' <$ string "\\r" |