Encode Long and ULong values as strings in json

flatironinstitute · Aug 14, 2023 · bd4160d · bd4160d
1 parent 7b46e47
commit bd4160d
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 6 deletions.
diff --git a/src/Ingest/GaiaDR3.hs b/src/Ingest/GaiaDR3.hs
@@ -46,8 +46,8 @@ indexLevel :: Int
 indexLevel = 59 - 2*level where level = 8
 
 -- |convert from source_id to file naming, HEALpix index level 8
-keyIndex :: Key -> Int
-keyIndex = fromIntegral . (`shiftR` indexLevel)
+_keyIndex :: Key -> Int
+_keyIndex = fromIntegral . (`shiftR` indexLevel)
 
 indexKey :: Int -> Key
 indexKey = (`shiftL` indexLevel) . fromIntegral

diff --git a/src/Ingest/HDF5.hs b/src/Ingest/HDF5.hs
@@ -622,9 +622,8 @@ ingestEagle inginfo = do
       return (n, b)
     nsub <- case ingestJoin info of
       Just IngestHaloJoin
-        { joinIngest = subinfo@Ingest{ ingestCatalog = Catalog{ catalogFields = subcat }, ingestJoin = Just (IngestJoin supfs) }
+        { joinIngest = subinfo@Ingest{ ingestJoin = Just (IngestJoin supfs) }
         , joinFirst = (`lookup` fof) -> Just (Long fofid)
-        , joinCount = fofcountf
         , joinParent = subgf
         } -> liftBaseOp (withGroup hf (simn <> "_Subhalo")) $ \hs -> do
         let fofmap = IM.fromDistinctAscList $ zip (map fromIntegral $ VS.toList fofid) [0..]

diff --git a/src/Type.hs b/src/Type.hs
@@ -42,6 +42,7 @@ module Type
 
 import           Control.Applicative ((<|>), many, empty)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.Types as J
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Builder as B
@@ -305,9 +306,24 @@ instance {-# OVERLAPPABLE #-} Show1 f => Show (TypeValue f) where
 instance Show Value where
   showsPrec i = unTypeValue (showsPrec i . runIdentity)
 
+_maxSafeJsInt :: Int64
+_maxSafeJsInt = 9007199254740991
+
+isUnsafeJs :: TypeValue f -> Bool
+isUnsafeJs (Long _) = True
+isUnsafeJs (ULong _) = True
+isUnsafeJs _ = False
+
 instance {-# OVERLAPPABLE #-} J.ToJSON1 f => J.ToJSON (TypeValue f) where
-  toJSON = unTypeValue J.toJSON1
-  toEncoding = unTypeValue J.toEncoding1
+  toJSON v
+    | isUnsafeJs v = unTypeValue (J.liftToJSON (J.toJSON . show) (J.toJSONList . map show)) v
+    | otherwise = unTypeValue J.toJSON1 v
+  toEncoding v
+    | isUnsafeJs v = unTypeValue (J.liftToEncoding toEncodingString (JE.list toEncodingString)) v
+    | otherwise = unTypeValue J.toEncoding1 v
+    where
+    toEncodingString :: Typed a => a -> J.Encoding
+    toEncodingString x = J.unsafeToEncoding $ B.char7 '"' <> renderValue x <> B.char7 '"'
 
 parseJSONOrStringValue :: Typed a => J.Value -> J.Parser a
 parseJSONOrStringValue j@(J.String s) = parseJSONValue j <|> maybe (fail "parseStringValue") return (readValue $ TE.encodeUtf8 s)