Browse Source

Fix some decoding bugs + add some new helpers

Getty Ritter 6 years ago
parent
commit
07b3556863
2 changed files with 28 additions and 3 deletions
  1. 23 1
      Data/Adnot/Class.hs
  2. 5 2
      Data/Adnot/Parse.hs

+ 23 - 1
Data/Adnot/Class.hs

@@ -212,6 +212,14 @@ withSum n k val = case val of
   Sum t as -> k t as
   _        -> Left ("Expected sum in " ++ n)
 
+withSumNamed :: String -> T.Text -> (Array -> Parser a) -> Value -> Parser a
+withSumNamed n tag k val = case val of
+  Sum t as
+    | tag == t -> k as
+    | otherwise -> Left $ unwords
+        [ "Expected tag", T.unpack tag, "in", n, "but found", T.unpack t ]
+  _        -> Left ("Expected sum in " ++ n)
+
 withProduct :: String -> (Product -> Parser a) -> Value -> Parser a
 withProduct n k val = case val of
   Product ps -> k ps
@@ -229,7 +237,8 @@ withInteger n k val = case val of
 
 withDouble :: String -> (Double -> Parser a) -> Value -> Parser a
 withDouble n k val = case val of
-  Double d -> k d
+  Double d  -> k d
+  Integer i -> k (fromIntegral i)
   _        -> Left ("Expected double in " ++ n)
 
 withSymbol :: String -> (T.Text -> Parser a) -> Value -> Parser a
@@ -242,6 +251,19 @@ withString n k val = case val of
   String s -> k s
   _        -> Left ("Expected string in " ++ n)
 
+(.:) :: FromAdnot a => Product -> T.Text -> Parser a
+map .: key = case MS.lookup key map of
+  Just x  -> parseAdnot x
+  Nothing -> Left ("Missing key " ++ show key)
+
+(.:?) :: FromAdnot a => Product -> T.Text -> Parser (Maybe a)
+map .:? key = case MS.lookup key map of
+  Just x  -> Just <$> parseAdnot x
+  Nothing -> return Nothing
+
+(.!=) :: Parser (Maybe a) -> a -> Parser a
+c .!= r = fmap (maybe r id) c
+
 class FromAdnot a where
   parseAdnot :: Value -> Parser a
 

+ 5 - 2
Data/Adnot/Parse.hs

@@ -5,8 +5,10 @@ module Data.Adnot.Parse (decodeValue) where
 import           Control.Applicative((<|>))
 import           Data.Attoparsec.ByteString.Char8
 import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS
 import qualified Data.Map as M
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import qualified Data.Vector as V
 
 import           Data.Adnot.Type
@@ -15,7 +17,7 @@ decodeValue :: ByteString -> Either String Value
 decodeValue = parseOnly pVal
   where pVal = ws *> (pSum <|> pProd <|> pList <|> pLit)
         pSum = Sum <$> (char '(' *> ws *> pIdent)
-                   <*> (pValueList <* char ')')
+                   <*> (pValueList <* ws <* char ')')
         pProd =  Product . M.fromList
              <$> (char '{' *> pProdBody <* ws <* char '}')
         pProdBody = many' pPair
@@ -23,12 +25,13 @@ decodeValue = parseOnly pVal
         pList = List <$> (char '[' *> pValueList <* ws <* char ']')
         pLit  =  Symbol  <$> pIdent
              <|> String  <$> pString
+             <|> Double  <$> double
              <|> Integer <$> decimal
         pValueList = V.fromList <$> many' pVal
         pIdent = T.pack <$>
                  ((:) <$> (letter_ascii <|> char '_')
                       <*> many' (letter_ascii <|> digit <|> char '_'))
-        pString = T.pack <$> (char '"' *> manyTill pStrChar (char '"'))
+        pString = T.decodeUtf8 . BS.pack <$> (char '"' *> manyTill pStrChar (char '"'))
         pStrChar =  '\n' <$ string "\\n"
                 <|> '\t' <$ string "\\t"
                 <|> '\r' <$ string "\\r"