Encode Long and ULong values as strings in json

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

src/Ingest/HDF5.hs

@@ -441,7 +441,7 @@
       gdir = dir </> "groups"
       isdm = "-Dark" `T.isSuffixOf` simn
       snap3 = printf "%03d" snap
       next Ingest{ ingestStart = s, ingestSize = Just z, ingestOffset = o, ingestJoin = j } = inginfo
         { ingestStart = s + z
         , ingestSize = Nothing
         , ingestOffset = if o > z then o - z else 0
@@ -622,9 +622,8 @@
       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..]
@@ -637,7 +636,7 @@
                   { ingestCatalog = (ingestCatalog subinfo){ catalogFieldGroups = fold (fieldSub f) }
                   , ingestOffset = 0
                   }) hg sups
             loop info sups = do
               liftIO $ rePutStr ("subhalo " <> show (ingestOffset info)) >> hFlush stdout
               (n, sb, info') <- liftIO $ loadBlock info hs
               gid <- case lookup subgf sb of

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)