diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2026 Michael Chavinda + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/dataframe-json.cabal b/dataframe-json.cabal new file mode 100644 --- /dev/null +++ b/dataframe-json.cabal @@ -0,0 +1,39 @@ +cabal-version: 2.4 +name: dataframe-json +version: 1.0.0.0 + +synopsis: JSON reader and writer for the dataframe ecosystem. +description: + @DataFrame.IO.JSON@ — read/write arrays of JSON objects as + 'DataFrame's. Built on @aeson@. + +bug-reports: https://github.com/mchav/dataframe/issues +license: MIT +license-file: LICENSE +author: Michael Chavinda +maintainer: mschavinda@gmail.com +copyright: (c) 2024-2025 Michael Chavinda +category: Data +tested-with: GHC ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 + +common warnings + ghc-options: + -Wincomplete-patterns + -Wincomplete-uni-patterns + -Wunused-imports + -Wunused-local-binds + +library + import: warnings + exposed-modules: DataFrame.IO.JSON + build-depends: base >= 4 && < 5, + aeson >= 0.11.0.0 && < 3, + bytestring >= 0.11 && < 0.13, + containers >= 0.6.7 && < 0.9, + dataframe-core ^>= 1.0, + dataframe-operations ^>= 1.0, + scientific >= 0.3.1 && < 0.4, + text >= 2.0 && < 3, + vector ^>= 0.13 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/DataFrame/IO/JSON.hs b/src/DataFrame/IO/JSON.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/IO/JSON.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE TypeApplications #-} + +module DataFrame.IO.JSON ( + readJSON, + readJSONEither, +) where + +import Control.Monad (forM) +import Data.Aeson +import qualified Data.Aeson.Key as K +import qualified Data.Aeson.KeyMap as KM +import qualified Data.ByteString.Lazy as LBS +import Data.Maybe (catMaybes) +import Data.Scientific (toRealFloat) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Vector as V + +import qualified DataFrame.Internal.Column as D +import qualified DataFrame.Internal.DataFrame as D +import qualified DataFrame.Operations.Core as D + +readJSONEither :: LBS.ByteString -> Either String D.DataFrame +readJSONEither bs = do + v <- note "Could not decode JSON" (decode @Value bs) + rows <- toArrayOfObjects v + let cols :: [Text] + cols = + uniq + . concatMap (map K.toText . KM.keys) + . V.toList + $ rows + + columns <- forM cols $ \c -> do + let col = buildColumn rows c + pure (c, col) + + pure $ D.fromNamedColumns columns + +readJSON :: FilePath -> IO D.DataFrame +readJSON path = do + contents <- LBS.readFile path + case readJSONEither contents of + Left err -> fail $ "readJSON: " <> err + Right df -> pure df + +toArrayOfObjects :: Value -> Either String (V.Vector Object) +toArrayOfObjects (Array xs) + | V.null xs = Left "Top-level JSON array is empty" + | otherwise = traverse asObject xs +toArrayOfObjects _ = + Left "Top-level JSON value must be a JSON array of objects" + +asObject :: Value -> Either String Object +asObject (Object o) = Right o +asObject _ = Left "Expected each element of the array to be an object" + +uniq :: (Ord a) => [a] -> [a] +uniq = go mempty + where + go _ [] = [] + go seen (x : xs) + | x `elem` seen = go seen xs + | otherwise = x : go (x : seen) xs + +note :: e -> Maybe a -> Either e a +note e = maybe (Left e) Right + +data ColType + = CTString + | CTNumber + | CTBool + | CTArray + | CTMixed + +buildColumn :: V.Vector Object -> Text -> D.Column +buildColumn rows colName = + let key = K.fromText colName + values :: V.Vector (Maybe Value) + values = V.map (KM.lookup key) rows + colType = detectColType values + in case colType of + CTString -> + D.fromVector (fmap (fmap asText) values) + CTNumber -> + D.fromVector (fmap (fmap asDouble) values) + CTBool -> + D.fromVector (fmap (fmap asBool) values) + CTArray -> + D.fromVector (fmap (fmap asArray) values) + CTMixed -> + D.fromVector values + +detectColType :: V.Vector (Maybe Value) -> ColType +detectColType vals = + case nonMissing of + [] -> CTMixed + vs + | all isString vs -> CTString + | all isNumber vs -> CTNumber + | all isBool vs -> CTBool + | all isArray vs -> CTArray + | otherwise -> CTMixed + where + nonMissing = catMaybes (V.toList vals) + + isString (String _) = True + isString _ = False + + isNumber (Number _) = True + isNumber _ = False + + isBool (Bool _) = True + isBool _ = False + + isArray (Array _) = True + isArray _ = False + +asText :: Value -> Text +asText (String s) = s +asText v = T.pack (show v) + +asDouble :: Value -> Double +asDouble (Number s) = toRealFloat @Double s +asDouble v = error $ "asDouble: non-number value: " <> show v + +asBool :: Value -> Bool +asBool (Bool b) = b +asBool v = error $ "asBool: non-bool value: " <> show v + +asArray :: Value -> V.Vector Value +asArray (Array a) = a +asArray v = error $ "asArray: non-array value: " <> show v