dataframe-parsing (empty) → 1.0.0.0
raw patch · 5 files changed
+466/−0 lines, 5 filesdep +attoparsecdep +basedep +bytestring
Dependencies added: attoparsec, base, bytestring, bytestring-lexing, containers, dataframe-core, text, time
Files
- LICENSE +20/−0
- dataframe-parsing.cabal +45/−0
- src/DataFrame/Internal/Binary.hs +94/−0
- src/DataFrame/Internal/Parsing.hs +219/−0
- src/DataFrame/Internal/Schema.hs +88/−0
+ LICENSE view
@@ -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.
+ dataframe-parsing.cabal view
@@ -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
+ src/DataFrame/Internal/Binary.hs view
@@ -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 #-}
+ src/DataFrame/Internal/Parsing.hs view
@@ -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)
+ src/DataFrame/Internal/Schema.hs view
@@ -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