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-parsing.cabal b/dataframe-parsing.cabal new file mode 100644 --- /dev/null +++ b/dataframe-parsing.cabal @@ -0,0 +1,45 @@ +cabal-version: 2.4 +name: dataframe-parsing +version: 1.0.0.0 + +synopsis: Shared text/binary parsing helpers for the dataframe ecosystem. +description: + Parsing primitives used by the @dataframe@ family: CSV-friendly text + parsing (@DataFrame.Internal.Parsing@), low-level binary decoding + helpers (@DataFrame.Internal.Binary@), and the runtime schema tag + (@DataFrame.Internal.Schema@). Kept in a small dedicated package so + @dataframe-csv@, @dataframe-parquet@, and @dataframe-operations@ can + share these without depending on each other. + +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.Internal.Binary + DataFrame.Internal.Parsing + DataFrame.Internal.Schema + build-depends: base >= 4 && < 5, + attoparsec >= 0.12 && < 0.15, + bytestring >= 0.11 && < 0.13, + bytestring-lexing >= 0.5 && < 0.6, + containers >= 0.6.7 && < 0.9, + dataframe-core ^>= 1.0, + text >= 2.0 && < 3, + time >= 1.12 && < 2 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/DataFrame/Internal/Binary.hs b/src/DataFrame/Internal/Binary.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Binary.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE BangPatterns #-} + +module DataFrame.Internal.Binary where + +import Data.Bits (Bits (unsafeShiftL, (.|.))) +import Data.ByteString (toStrict) +import qualified Data.ByteString as BS +import Data.ByteString.Builder (toLazyByteString, word32LE, word64LE) +import qualified Data.ByteString.Unsafe as BS +import Data.Int (Int32) +import Data.Word (Word32, Word64, Word8) + +littleEndianWord32 :: BS.ByteString -> Word32 +littleEndianWord32 bytes + | len >= 4 = + assembleWord32 + (BS.unsafeIndex bytes 0) + (BS.unsafeIndex bytes 1) + (BS.unsafeIndex bytes 2) + (BS.unsafeIndex bytes 3) + | otherwise = + assembleWord32 + (byteAtOrZero len bytes 0) + (byteAtOrZero len bytes 1) + (byteAtOrZero len bytes 2) + (byteAtOrZero len bytes 3) + where + len = BS.length bytes +{-# INLINE littleEndianWord32 #-} + +littleEndianWord64 :: BS.ByteString -> Word64 +littleEndianWord64 bytes + | len >= 8 = + assembleWord64 + (BS.index bytes 0) + (BS.index bytes 1) + (BS.index bytes 2) + (BS.index bytes 3) + (BS.index bytes 4) + (BS.index bytes 5) + (BS.index bytes 6) + (BS.index bytes 7) + | otherwise = + assembleWord64 + (byteAtOrZero len bytes 0) + (byteAtOrZero len bytes 1) + (byteAtOrZero len bytes 2) + (byteAtOrZero len bytes 3) + (byteAtOrZero len bytes 4) + (byteAtOrZero len bytes 5) + (byteAtOrZero len bytes 6) + (byteAtOrZero len bytes 7) + where + len = BS.length bytes +{-# INLINE littleEndianWord64 #-} + +littleEndianInt32 :: BS.ByteString -> Int32 +littleEndianInt32 = fromIntegral . littleEndianWord32 +{-# INLINE littleEndianInt32 #-} + +word64ToLittleEndian :: Word64 -> BS.ByteString +word64ToLittleEndian = toStrict . toLazyByteString . word64LE +{-# INLINE word64ToLittleEndian #-} + +word32ToLittleEndian :: Word32 -> BS.ByteString +word32ToLittleEndian = toStrict . toLazyByteString . word32LE +{-# INLINE word32ToLittleEndian #-} + +byteAtOrZero :: Int -> BS.ByteString -> Int -> Word8 +byteAtOrZero len bytes i + | i >= 0 && i < len = BS.unsafeIndex bytes i + | otherwise = 0 +{-# INLINE byteAtOrZero #-} + +assembleWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 +assembleWord32 !b0 !b1 !b2 !b3 = + fromIntegral b0 + .|. (fromIntegral b1 `unsafeShiftL` 8) + .|. (fromIntegral b2 `unsafeShiftL` 16) + .|. (fromIntegral b3 `unsafeShiftL` 24) +{-# INLINE assembleWord32 #-} + +assembleWord64 :: + Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64 +assembleWord64 !b0 !b1 !b2 !b3 !b4 !b5 !b6 !b7 = + fromIntegral b0 + .|. (fromIntegral b1 `unsafeShiftL` 8) + .|. (fromIntegral b2 `unsafeShiftL` 16) + .|. (fromIntegral b3 `unsafeShiftL` 24) + .|. (fromIntegral b4 `unsafeShiftL` 32) + .|. (fromIntegral b5 `unsafeShiftL` 40) + .|. (fromIntegral b6 `unsafeShiftL` 48) + .|. (fromIntegral b7 `unsafeShiftL` 56) +{-# INLINE assembleWord64 #-} diff --git a/src/DataFrame/Internal/Parsing.hs b/src/DataFrame/Internal/Parsing.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DataFrame.Internal.Parsing where + +import qualified Data.ByteString.Char8 as C +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Control.Applicative (many, (<|>)) +import Data.Attoparsec.Text hiding (decimal, double, signed) +import Data.ByteString.Lex.Fractional +import Data.Foldable (fold) +import Data.Text.Read (decimal, double, signed) +import Data.Time (Day, defaultTimeLocale, parseTimeM) +import GHC.Stack (HasCallStack) +import System.IO (Handle, IOMode (..), hIsEOF, hTell, withFile) +import Prelude hiding (takeWhile) + +isNullish :: T.Text -> Bool +isNullish = + ( `S.member` + S.fromList + ["Nothing", "NULL", "", " ", "nan", "null", "N/A", "NaN", "NAN", "NA"] + ) + +isNullishBS :: C.ByteString -> Bool +isNullishBS = + ( `S.member` + S.fromList + ["Nothing", "NULL", "", " ", "nan", "null", "N/A", "NaN", "NAN", "NA"] + ) + +isTrueish :: T.Text -> Bool +isTrueish t = t `elem` ["True", "true", "TRUE"] + +isFalseish :: T.Text -> Bool +isFalseish t = t `elem` ["False", "false", "FALSE"] + +readBool :: (HasCallStack) => T.Text -> Maybe Bool +readBool s + | isTrueish s = Just True + | isFalseish s = Just False + | otherwise = Nothing + +readByteStringBool :: C.ByteString -> Maybe Bool +readByteStringBool s + | s `elem` ["True", "true", "TRUE"] = Just True + | s `elem` ["False", "false", "FALSE"] = Just False + | otherwise = Nothing + +readByteStringDate :: String -> C.ByteString -> Maybe Day +readByteStringDate fmt = parseTimeM True defaultTimeLocale fmt . C.unpack + +readInteger :: (HasCallStack) => T.Text -> Maybe Integer +readInteger s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (_value, _) -> Nothing + +readInt :: (HasCallStack) => T.Text -> Maybe Int +readInt s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (_value, _) -> Nothing +{-# INLINE readInt #-} + +readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int +readByteStringInt s = case C.readInt (C.strip s) of + Nothing -> Nothing + Just (value, "") -> Just value + Just (_value, _) -> Nothing +{-# INLINE readByteStringInt #-} + +readByteStringDouble :: (HasCallStack) => C.ByteString -> Maybe Double +readByteStringDouble s = + let + readFunc = if C.any (\c -> c == 'e' || c == 'E') s then readExponential else readDecimal + in + case readSigned readFunc (C.strip s) of + Nothing -> Nothing + Just (value, "") -> Just value + Just (_value, _) -> Nothing +{-# INLINE readByteStringDouble #-} + +readDouble :: (HasCallStack) => T.Text -> Maybe Double +readDouble s = + case signed double s of + Left _ -> Nothing + Right (value, "") -> Just value + Right (_value, _) -> Nothing +{-# INLINE readDouble #-} + +readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer +readIntegerEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (_value, _) -> Left s +{-# INLINE readIntegerEither #-} + +readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int +readIntEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (_value, _) -> Left s +{-# INLINE readIntEither #-} + +readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double +readDoubleEither s = + case signed double s of + Left _ -> Left s + Right (value, "") -> Right value + Right (_value, _) -> Left s +{-# INLINE readDoubleEither #-} + +-- --------------------------------------------------------------------------- +-- Attoparsec CSV parser combinators (shared between Lazy.IO.CSV and others) +-- --------------------------------------------------------------------------- + +parseSep :: Char -> T.Text -> [T.Text] +parseSep c s = either error id (parseOnly (record c) s) +{-# INLINE parseSep #-} + +record :: Char -> Parser [T.Text] +record c = + field c `sepBy1` char c + "record" +{-# INLINE record #-} + +parseRow :: Char -> Parser [T.Text] +parseRow c = (record c <* lineEnd) "record-new-line" + +field :: Char -> Parser T.Text +field c = + quotedField <|> unquotedField c + "field" +{-# INLINE field #-} + +unquotedTerminators :: Char -> S.Set Char +unquotedTerminators sep = S.fromList [sep, '\n', '\r', '"'] + +unquotedField :: Char -> Parser T.Text +unquotedField sep = + takeWhile (not . (`S.member` terminators)) "unquoted field" + where + terminators = unquotedTerminators sep +{-# INLINE unquotedField #-} + +quotedField :: Parser T.Text +quotedField = char '"' *> contents <* char '"' "quoted field" + where + contents = fold <$> many (unquote <|> unescape) + where + unquote = takeWhile1 (notInClass "\"\\") + unescape = + char '\\' *> do + T.singleton <$> do + char '\\' <|> char '"' +{-# INLINE quotedField #-} + +lineEnd :: Parser () +lineEnd = + (endOfLine <|> endOfInput) + "end of line" +{-# INLINE lineEnd #-} + +-- | First pass to count rows for exact allocation. +countRows :: Char -> FilePath -> IO Int +countRows c path = withFile path ReadMode $! go 0 "" + where + go n input h = do + isEOF <- hIsEOF h + if isEOF && input == mempty + then pure n + else + parseWith (TIO.hGetChunk h) (parseRow c) input >>= \case + Fail unconsumed ctx er -> do + erpos <- hTell h + fail $ + "Failed to parse CSV file around " + <> show erpos + <> " byte; due: " + <> show er + <> "; context: " + <> show ctx + <> " " + <> show unconsumed + Partial _ -> fail $ "Partial handler is called; n = " <> show n + Done (unconsumed :: T.Text) _ -> + go (n + 1) unconsumed h +{-# INLINE countRows #-} + +-- | Infer the Haskell type name from a text sample. +inferValueType :: T.Text -> T.Text +inferValueType s = case readInt s of + Just _ -> "Int" + Nothing -> case readDouble s of + Just _ -> "Double" + Nothing -> "Other" +{-# INLINE inferValueType #-} + +-- | Read a single CSV row from a handle using the given separator. +readSingleLine :: Char -> T.Text -> Handle -> IO ([T.Text], T.Text) +readSingleLine c unused handle = + parseWith (TIO.hGetChunk handle) (parseRow c) unused >>= \case + Fail _unconsumed ctx er -> do + erpos <- hTell handle + fail $ + "Failed to parse CSV file around " + <> show erpos + <> " byte; due: " + <> show er + <> "; context: " + <> show ctx + Partial _ -> fail "Partial handler is called" + Done (unconsumed :: T.Text) (row :: [T.Text]) -> + return (row, unconsumed) diff --git a/src/DataFrame/Internal/Schema.hs b/src/DataFrame/Internal/Schema.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Schema.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{- | +Runtime schema representation. The Template-Haskell @deriveSchema@ splice +lives in "DataFrame.Internal.Schema.TH" so this module can be used from +packages that do not depend on @template-haskell@. +-} +module DataFrame.Internal.Schema ( + SchemaType (..), + schemaType, + Schema (..), + makeSchema, +) where + +import qualified Data.Map as M +import Data.Maybe (isJust) +import qualified Data.Proxy as P +import qualified Data.Text as T +import Data.Type.Equality (TestEquality (..)) +import DataFrame.Internal.Column (Columnable) +import Type.Reflection (typeRep) + +-- | A runtime tag for a column’s element type. +data SchemaType where + -- | Constructor carrying a 'Proxy' of the element type. + SType :: (Columnable a, Read a) => P.Proxy a -> SchemaType + +{- | Show the underlying element type using 'typeRep'. + +==== __Examples__ +>>> :set -XTypeApplications +>>> show (schemaType @Bool) +"Bool" +-} +instance Show SchemaType where + show :: SchemaType -> String + show (SType (_ :: P.Proxy a)) = show (typeRep @a) + +{- | Two 'SchemaType's are equal iff their element types are the same. + +==== __Examples__ +>>> :set -XTypeApplications +>>> schemaType @Int == schemaType @Int +True + +>>> schemaType @Int == schemaType @Integer +False +-} +instance Eq SchemaType where + (==) :: SchemaType -> SchemaType -> Bool + (==) (SType (_ :: P.Proxy a)) (SType (_ :: P.Proxy b)) = + isJust (testEquality (typeRep @a) (typeRep @b)) + +{- | Construct a 'SchemaType' for the given @a@. + +==== __Examples__ +>>> :set -XTypeApplications +>>> schemaType @T.Text == schemaType @T.Text +True + +>>> show (schemaType @Double) +"Double" +-} +schemaType :: forall a. (Columnable a, Read a) => SchemaType +schemaType = SType (P.Proxy @a) + +{- | Logical schema of a 'DataFrame': a mapping from column names to their +element types ('SchemaType'). +-} +newtype Schema = Schema + { elements :: M.Map T.Text SchemaType + {- ^ Mapping from /column name/ to its 'SchemaType'. + + Invariant: keys are unique column names. A missing key means the column + is not present in the schema. + -} + } + deriving (Show, Eq) + +-- | Construct a 'Schema' from a list of @(columnName, schemaType)@ pairs. +makeSchema :: [(T.Text, SchemaType)] -> Schema +makeSchema = Schema . M.fromList