diff --git a/Frames.cabal b/Frames.cabal --- a/Frames.cabal +++ b/Frames.cabal @@ -1,5 +1,5 @@ name: Frames -version: 0.6.0 +version: 0.6.1 synopsis: Data frames For working with tabular data files description: User-friendly, type safe, runtime efficient tooling for working with tabular data deserialized from @@ -15,7 +15,7 @@ category: Data build-type: Simple extra-source-files: benchmarks/*.hs benchmarks/*.py - demo/Main.hs CHANGELOG.md README.md + demo/framestack/app/Main.hs CHANGELOG.md README.md data/GetData.hs test/examples.toml test/data/managers.csv test/data/employees.csv @@ -29,7 +29,7 @@ data/left1.csv data/right1.csv data/left_summary.csv data/FL2.csv cabal-version: >=1.10 -tested-with: GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1 +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 source-repository head type: git @@ -76,7 +76,7 @@ pipes-parse >= 3.0 && < 3.1, pipes-safe >= 2.2.6 && < 2.4, bytestring, - vinyl >= 0.10.0 && < 0.11, + vinyl >= 0.10.0 && < 0.12, discrimination, contravariant, hashable, @@ -142,7 +142,7 @@ build-depends: base, list-t, microlens, transformers, Frames, vector, text, template-haskell, ghc-prim, readable, pipes - hs-source-dirs: demo + hs-source-dirs: demo/framestack/app default-language: Haskell2010 ghc-options: -O2 -- ghc-options: -O2 -fllvm @@ -218,7 +218,7 @@ main-is: Spec.hs other-modules: DataCSV PrettyTH Temp LatinTest Issue114 NoHeader UncurryFold UncurryFoldNoHeader UncurryFoldPartialData - Categorical + Categorical Chunks build-depends: base, text, hspec, Frames, template-haskell, temporary, directory, htoml, regex-applicative, pretty, unordered-containers, pipes, HUnit, vinyl, diff --git a/demo/Main.hs b/demo/Main.hs deleted file mode 100644 --- a/demo/Main.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE BangPatterns, DataKinds, TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts, TypeApplications, TypeOperators #-} -module Main where -import Data.Functor.Identity -import Frames -import Lens.Micro -import qualified Pipes as P -import qualified Pipes.Prelude as P - -tableTypes "Row" "data/data1.csv" - -tbl :: IO [Row] -tbl = runSafeT . P.toListM $ readTable "data/data1.csv" - -ageDoubler :: (Age ∈ rs) => Record rs -> Record rs -ageDoubler = age %~ (* 2) - -tbl2 :: IO [Row] -tbl2 = runSafeT . P.toListM $ readTable "data/data2.csv" - -tbl2a :: IO [ColFun Maybe Row] -tbl2a = runSafeT . P.toListM $ readTableMaybe "data/data2.csv" - -{- - -REPL examples: - -λ> tbl >>= mapM_ print -{name :-> "joe", age :-> 21} -{name :-> "sue", age :-> 23} -{name :-> "bob", age :-> 44} -{name :-> "laura", age :-> 18} - -λ> tbl2 >>= mapM_ print -{name :-> "joe", age :-> 21} -{name :-> "sue", age :-> 23} -{name :-> "laura", age :-> 18} - -λ> tbl2a >>= mapM_ (putStrLn . showRecF) -{Just (name :-> "joe"), Just (age :-> 21)} -{Just (name :-> "sue"), Just (age :-> 23)} -{Just (name :-> "bob"), Nothing} -{Just (name :-> "laura"), Just (age :-> 18)} - --} - --- Sample data from http://support.spatialkey.com/spatialkey-sample-csv-data/ --- Note: We have to replace carriage returns (\r) with line feed --- characters (\n) for the text library's line parsing to work. -tableTypes "Ins" "data/FL2.csv" - -insuranceTbl :: MonadSafe m => P.Producer Ins m () -insuranceTbl = readTable "data/FL2.csv" - -insMaybe :: MonadSafe m => P.Producer (ColFun Maybe Ins) m () -insMaybe = readTableMaybe "data/FL2.csv" - -type TinyIns = Record [PolicyID, PointLatitude, PointLongitude] - -main :: IO () -main = do itbl <- inCore $ P.for insuranceTbl (P.yield . rcast) - :: IO (P.Producer TinyIns Identity ()) - putStrLn "In-core representation prepared" - let Identity (n,sumLat) = - P.fold (\ !(!i,!s) r -> (i+1, s+rgetField @PointLatitude r)) - (0::Int,0) - id - itbl - putStrLn $ "Considering " ++ show n ++ " records..." - putStrLn $ "Average latitude: " ++ show (sumLat / fromIntegral n) - let Identity sumLong = - P.fold (\ !s r -> (s + rgetField @PointLongitude r)) 0 id itbl - putStrLn $ "Average longitude: " ++ show (sumLong / fromIntegral n) diff --git a/demo/framestack/app/Main.hs b/demo/framestack/app/Main.hs new file mode 100644 --- /dev/null +++ b/demo/framestack/app/Main.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE BangPatterns, DataKinds, TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts, TypeApplications, TypeOperators #-} +module Main where +import Data.Functor.Identity +import Frames +import Lens.Micro +import qualified Pipes as P +import qualified Pipes.Prelude as P + +tableTypes "Row" "../../data/data1.csv" + +tbl :: IO [Row] +tbl = runSafeT . P.toListM $ readTable "../../data/data1.csv" + + +ageDoubler :: (Age ∈ rs) => Record rs -> Record rs +ageDoubler = age %~ (* 2) + +tbl2 :: IO [Row] +tbl2 = runSafeT . P.toListM $ readTable "../../data/data2.csv" + +tbl2a :: IO [ColFun Maybe Row] +tbl2a = runSafeT . P.toListM $ readTableMaybe "../../data/data2.csv" + +-- Sample data from http://support.spatialkey.com/spatialkey-sample-csv-data/ +-- Note: We have to replace carriage returns (\r) with line feed +-- characters (\n) for the text library's line parsing to work. +tableTypes "Ins" "../../data/FL2.csv" + +insuranceTbl :: MonadSafe m => P.Producer Ins m () +insuranceTbl = readTable "../../data/FL2.csv" + +insMaybe :: MonadSafe m => P.Producer (ColFun Maybe Ins) m () +insMaybe = readTableMaybe "../../data/FL2.csv" + +type TinyIns = Record [PolicyID, PointLatitude, PointLongitude] + +main :: IO () +main = do itbl <- inCore $ P.for insuranceTbl (P.yield . rcast) + :: IO (P.Producer TinyIns Identity ()) + putStrLn "In-core representation prepared" + let Identity (n,sumLat) = + P.fold (\ !(!i,!s) r -> (i+1, s+rgetField @PointLatitude r)) + (0::Int,0) + id + itbl + putStrLn $ "Considering " ++ show n ++ " records..." + putStrLn $ "Average latitude: " ++ show (sumLat / fromIntegral n) + let Identity sumLong = + P.fold (\ !s r -> (s + rgetField @PointLongitude r)) 0 id itbl + putStrLn $ "Average longitude: " ++ show (sumLong / fromIntegral n) diff --git a/src/Frames/ColumnTypeable.hs b/src/Frames/ColumnTypeable.hs --- a/src/Frames/ColumnTypeable.hs +++ b/src/Frames/ColumnTypeable.hs @@ -6,6 +6,7 @@ import Data.Readable (Readable(fromText)) import Data.Typeable (Proxy(..), typeRep, Typeable) import qualified Data.Text as T +import Data.Int (Int32, Int64) import Data.Vinyl.Functor (Const(..)) import Language.Haskell.TH @@ -58,10 +59,21 @@ parse' :: (MonadPlus m, Parseable a) => T.Text -> m a parse' = fmap discardConfidence . parse +parseIntish :: (Readable a, MonadPlus f) => T.Text -> f (Parsed a) +parseIntish t = + Definitely <$> fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t)) + instance Parseable Bool where + instance Parseable Int where - parse t = Definitely <$> - fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t)) + parse = parseIntish +instance Parseable Int32 where + parse = parseIntish +instance Parseable Int64 where + parse = parseIntish +instance Parseable Integer where + parse = parseIntish + instance Parseable Float where instance Parseable Double where -- Some CSV's export Doubles in a format like '1,000.00', filtering diff --git a/src/Frames/ColumnUniverse.hs b/src/Frames/ColumnUniverse.hs --- a/src/Frames/ColumnUniverse.hs +++ b/src/Frames/ColumnUniverse.hs @@ -156,9 +156,11 @@ inferType = bestRep {-# INLINABLE inferType #-} +#if !MIN_VERSION_vinyl(0,11,0) instance forall ts. (RPureConstrained Show ts, RecApplicative ts) => Show (CoRec ColInfo ts) where show x = "(Col " ++ onCoRec @Show show x ++")" +#endif -- * Common Columns diff --git a/src/Frames/InCore.hs b/src/Frames/InCore.hs --- a/src/Frames/InCore.hs +++ b/src/Frames/InCore.hs @@ -149,7 +149,8 @@ -- which provides an easier-to-use function that indexes into the -- table in a row-major fashion. inCoreSoA :: forall m rs. (PrimMonad m, RecVec rs) - => P.Producer (Record rs) m () -> m (Int, V.Rec (((->) Int) :. ElField) rs) + => P.Producer (Record rs) m () + -> m (Int, V.Rec (((->) Int) :. ElField) rs) inCoreSoA xs = do mvs <- allocRec (Proxy :: Proxy rs) initialCapacity let feed (!i, !sz, !mvs') row @@ -220,3 +221,39 @@ filterFrame :: RecVec rs => (Record rs -> Bool) -> FrameRec rs -> FrameRec rs filterFrame p f = runST $ inCoreAoS $ P.each f P.>-> P.filter p {-# INLINE filterFrame #-} + +-- | Process a stream of 'Record's into a stream of 'Frame's that each +-- contains no more than the given number of records. +produceFrameChunks :: forall rs m. (RecVec rs, PrimMonad m) + => Int + -> P.Producer (Record rs) m () + -> P.Producer (FrameRec rs) m () +produceFrameChunks chunkSize = go + where go src = do mutVecs <- P.lift (allocRec (Proxy :: Proxy rs) chunkSize) + goChunk src mutVecs 0 + goChunk src mutVecs !i + | i >= chunkSize = + do chunk <- P.lift (freezeFrame i mutVecs) + P.yield chunk + go src + | otherwise = + do maybeRow <- P.lift (P.next src) + case maybeRow of + Left _ -> do + P.lift (freezeFrame i mutVecs) >>= P.yield + Right (r,src') -> do + P.lift (writeRec (Proxy::Proxy rs) i mutVecs r) + goChunk src' mutVecs (i+1) + freezeFrame :: Int -> Record (VectorMs m rs) -> m (FrameRec rs) + freezeFrame n = + fmap (toAoS n . produceRec (Proxy::Proxy rs)) + . freezeRec (Proxy::Proxy rs) n +{-# INLINABLE produceFrameChunks #-} + +-- | Split a 'Frame' into chunks of no more than the given number of +-- records. The underlying memory is shared with the original 'Frame'. +frameChunks :: Int -> FrameRec rs -> [FrameRec rs] +frameChunks chunkSize whole = map aux [ 0, chunkSize .. frameLength whole - 1 ] + where aux i = Frame (min (frameLength whole - i) chunkSize) + (frameRow whole . (+ i)) +{-# INLINABLE frameChunks #-} diff --git a/test/Chunks.hs b/test/Chunks.hs new file mode 100644 --- /dev/null +++ b/test/Chunks.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, + TemplateHaskell, TypeApplications #-} +module Chunks where +import Frames +import Frames.InCore (frameChunks, produceFrameChunks) +import Pipes ((>->)) +import qualified Pipes.Prelude as P + +tableTypes "Row" "test/data/prestige.csv" + +getEducation :: Row -> Double +getEducation = rgetField @Education + +chunkInCore :: IO [Double] +chunkInCore = do + rows <- inCoreAoS (readTable "test/data/prestige.csv") + let chunks = frameChunks 10 rows + return $ map (getEducation . flip frameRow 0) chunks + +chunkStream :: IO [Double] +chunkStream = runSafeT . P.toListM $ + produceFrameChunks 10 (readTable "test/data/prestige.csv") + >-> P.map (getEducation . flip frameRow 0) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -7,7 +7,7 @@ import Data.Functor.Identity import Data.Char import qualified Data.Foldable as F -import Data.List (find) +import Data.List (find, isPrefixOf) import Data.Monoid (First(..)) import qualified Data.Text as T import Language.Haskell.TH as TH @@ -15,6 +15,7 @@ import Frames import Frames.CSV (produceCSV) import Frames.CSV (defaultParser, produceTokens, defaultSep, readColHeaders) +import qualified Chunks import DataCSV import Pipes.Prelude (toListM) import PrettyTH @@ -81,7 +82,16 @@ newtype Code = Code String instance Show Code where show (Code x) = x instance Eq Code where - Code a == Code b = filter (not . isSpace) a == filter (not . isSpace) b + Code a == Code b = clean a == clean b + where clean = go (removePrefix moduleNames) . filter (not . isSpace) + go _ [] = [] + go f s@(c:cs) = case removePrefix moduleNames s of + Nothing -> c : go f cs + Just n -> go f (drop n s) + moduleNames = [ "GHC.Maybe." ] + removePrefix [] _ = Nothing + removePrefix (w:ws) s | w `isPrefixOf` s = Just (length w) + | otherwise = removePrefix ws s shouldBeWithinEpsilon :: Double -> Double -> Expectation shouldBeWithinEpsilon actual expected = @@ -201,3 +211,11 @@ return False) `catch` \(_ :: ErrorCall) -> return True it "Fails on embedded newlines" caught + describe "Chunking" $ do + let everyTenthEducation = [13.11,12.39,15.97,12.79,12.09,11.13,8.5,7.64,8.78,6.92,10.0] + inCoreChunks <- H.runIO Chunks.chunkInCore + it "Can split in-memory data into chunks" $ + inCoreChunks `shouldBe` everyTenthEducation + streamedChunks <- H.runIO Chunks.chunkStream + it "Can split an input stream into Frame chunks" $ + streamedChunks `shouldBe` everyTenthEducation