dataframe-th 2.2.1.0 → 2.3.0.0
raw patch · 4 files changed
+145/−73 lines, 4 filesdep +timedep ~dataframe-coredep ~dataframe-operations
Dependencies added: time
Dependency ranges changed: dataframe-core, dataframe-operations
Files
- dataframe-th.cabal +4/−3
- src/DataFrame/Internal/Schema/TH.hs +11/−14
- src/DataFrame/TH/Records.hs +121/−35
- src/DataFrame/Typed/TH/Records.hs +9/−21
dataframe-th.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: dataframe-th-version: 2.2.1.0+version: 2.3.0.0 synopsis: Record-based Template Haskell splices for the dataframe ecosystem. description: The IO-agnostic part of the @dataframe@ TH machinery — splices that@@ -34,11 +34,12 @@ other-modules: DataFrame.Internal.Schema.TH build-depends: base >= 4 && < 5, containers >= 0.6.7 && < 0.10,- dataframe-core >= 2.5 && < 2.6,- dataframe-operations >= 2.5 && < 2.6,+ dataframe-core >= 2.6 && < 2.7,+ dataframe-operations >= 2.6 && < 2.7, dataframe-parsing >= 2.2 && < 2.3, template-haskell >= 2.0 && < 3, text >= 2.1 && < 3,+ time >= 1.12 && < 2, vector >= 0.13 && < 0.15 hs-source-dirs: src default-language: Haskell2010
src/DataFrame/Internal/Schema/TH.hs view
@@ -3,28 +3,27 @@ {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TypeApplications #-} -{- |-Template-Haskell @deriveSchema@ splice for "DataFrame.Internal.Schema".-Kept in a separate module so the runtime schema types in-"DataFrame.Internal.Schema" do not pull in @template-haskell@.--}+-- | Template-Haskell @deriveSchema@ splice for "DataFrame.Internal.Schema". module DataFrame.Internal.Schema.TH ( deriveSchema,+ schemaTypeE, camelToSnake, ) where import Data.Char (isUpper, toLower, toUpper)+import qualified Data.Proxy as P import qualified Data.Text as T import Language.Haskell.TH import DataFrame.Expression.Operators (col) import DataFrame.Internal.Expression (Expr)-import DataFrame.Schema (Schema, makeSchema, schemaType)+import DataFrame.Schema (Schema, SchemaType (..), makeSchema) -{- | Auto-generate a runtime 'Schema' (and per-column @'Expr'@ accessors)-from a record ADT. Emits @\<tyName\>Schema@ plus one accessor per field-(@camelCase -> snake_case@). Requires a single record constructor.--}+schemaTypeE :: Type -> Exp+schemaTypeE ty =+ ConE 'SType `AppE` SigE (ConE 'P.Proxy) (ConT ''P.Proxy `AppT` ty)++-- | Auto-generate a runtime 'Schema' and per-column accessors from a record. deriveSchema :: Name -> DecsQ deriveSchema tyName = do info <- reify tyName@@ -39,7 +38,7 @@ tupleE (colName, _, fTy) = TupE [ Just (AppE (VarE 'T.pack) (LitE (StringL colName)))- , Just (AppTypeE (VarE 'schemaType) fTy)+ , Just (schemaTypeE fTy) ] schemaBody = AppE (VarE 'makeSchema) (ListE (map tupleE entries))@@ -89,9 +88,7 @@ ++ show tyName ++ " is not a data/newtype declaration" -{- | @camelCase -> snake_case@. Lowercases the first character then prefixes-@\'_\'@ before every uppercase character (lowercased).--}+-- | Convert @camelCase@ to @snake_case@. camelToSnake :: String -> String camelToSnake [] = [] camelToSnake (c : cs) = toLower c : go cs
src/DataFrame/TH/Records.hs view
@@ -4,30 +4,37 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} -{- |-Module : DataFrame.TH.Records-License : MIT--Record-based 'DataFrame' splices — the IO-agnostic core of the-'DataFrame.TH' family. Splices that read CSV / Parquet files at compile-time live in @DataFrame.TH.CSV@ (in @dataframe-csv-th@) and-@DataFrame.TH.Parquet@ (in @dataframe-parquet-th@).--}+-- | Record-based 'DataFrame' splices, the IO-agnostic core of 'DataFrame.TH'. module DataFrame.TH.Records ( -- * Declare one binding per column declareColumns, declareColumnsWithPrefix, declareColumnsWithPrefix', + -- * Declare a runtime schema alongside the column bindings+ declareSchemaValues,+ -- * Type-string parser (exposed for testing) typeFromString, ) where +import qualified Data.Char as Char import Data.Function (on) import Data.Functor ((<&>))+import Data.Int (Int16, Int32, Int64, Int8) import qualified Data.List as L import qualified Data.Map as M import qualified Data.Text as T+import Data.Time (+ Day,+ DiffTime,+ LocalTime,+ NominalDiffTime,+ TimeOfDay,+ UTCTime,+ ZonedTime,+ )+import Data.Word (Word16, Word32, Word64, Word8) import Control.Monad (forM) import Language.Haskell.TH@@ -41,8 +48,40 @@ unsafeGetColumn, ) import DataFrame.Internal.Expression (Expr)+import DataFrame.Internal.Schema.TH (schemaTypeE)+import DataFrame.Schema (Schema, makeSchema) import Prelude as P +knownTypeNames :: M.Map String Name+knownTypeNames =+ M.fromList+ [ ("Bool", ''Bool)+ , ("Char", ''Char)+ , ("Day", ''Day)+ , ("DiffTime", ''DiffTime)+ , ("Double", ''Double)+ , ("Either", ''Either)+ , ("Float", ''Float)+ , ("Int", ''Int)+ , ("Int16", ''Int16)+ , ("Int32", ''Int32)+ , ("Int64", ''Int64)+ , ("Int8", ''Int8)+ , ("Integer", ''Integer)+ , ("LocalTime", ''LocalTime)+ , ("Maybe", ''Maybe)+ , ("NominalDiffTime", ''NominalDiffTime)+ , ("Ordering", ''Ordering)+ , ("TimeOfDay", ''TimeOfDay)+ , ("UTCTime", ''UTCTime)+ , ("Word", ''Word)+ , ("Word16", ''Word16)+ , ("Word32", ''Word32)+ , ("Word64", ''Word64)+ , ("Word8", ''Word8)+ , ("ZonedTime", ''ZonedTime)+ ]+ typeFromString :: [String] -> Q Type typeFromString [] = fail "No type specified" typeFromString [t0] = do@@ -56,7 +95,9 @@ m <- lookupTypeName t case m of Just tyName -> pure (ConT tyName)- Nothing -> fail $ "Unsupported type: " ++ t0+ Nothing -> case M.lookup t knownTypeNames of+ Just tyName -> pure (ConT tyName)+ Nothing -> fail $ "Unsupported type: " ++ t0 typeFromString [tycon, t1] = AppT <$> typeFromString [tycon] <*> typeFromString [t1] typeFromString [tycon, t1, t2] = (\outer a b -> AppT (AppT outer a) b)@@ -76,10 +117,14 @@ Just (init rest) _ -> Nothing -{- | Splice a binding for every column of @df@, named after the column.-Column names that are not valid Haskell identifiers are sanitized-(see 'DataFrame.Functions.sanitize').--}+columnSpecs :: DataFrame -> Q [(T.Text, Type)]+columnSpecs df =+ let names = (map fst . L.sortBy (compare `on` snd) . M.toList . columnIndices) df+ types = map (columnTypeString . (`unsafeGetColumn` df)) names+ in forM (zip names types) $ \(colName, tyStr) ->+ (,) colName <$> typeFromString (words tyStr)++-- | Splice a binding for every column of @df@, named after the column. declareColumns :: DataFrame -> DecsQ declareColumns = declareColumnsWithPrefix' Nothing @@ -89,24 +134,65 @@ -- | Like 'declareColumnsWithPrefix' but takes an optional prefix. declareColumnsWithPrefix' :: Maybe T.Text -> DataFrame -> DecsQ-declareColumnsWithPrefix' prefix df =- let- names = (map fst . L.sortBy (compare `on` snd) . M.toList . columnIndices) df- types = map (columnTypeString . (`unsafeGetColumn` df)) names- specs =- zipWith- ( \colName type_ ->- ( colName- , maybe "" (sanitize . (<> "_")) prefix <> sanitize colName- , type_- )- )- names- types- in- fmap concat $ forM specs $ \(raw, nm, tyStr) -> do- ty <- typeFromString (words tyStr)- let n = mkName (T.unpack nm)- sig <- sigD n [t|Expr $(pure ty)|]- val <- valD (varP n) (normalB [|col $(TH.lift raw)|]) []- pure [sig, val]+declareColumnsWithPrefix' prefix df = do+ specs <- columnSpecs df+ fmap concat $ forM specs $ \(raw, ty) -> do+ let nm = maybe "" (sanitize . (<> "_")) prefix <> sanitize raw+ n = mkName (T.unpack nm)+ sig <- sigD n [t|Expr $(pure ty)|]+ val <- valD (varP n) (normalB [|col $(TH.lift raw)|]) []+ pure [sig, val]++-- | Splice a runtime 'Schema' for @df@ along with per-column 'Expr' refs.+declareSchemaValues :: String -> DataFrame -> DecsQ+declareSchemaValues prefix df = do+ validatePrefix prefix+ specs <- columnSpecs df+ let n = mkName (prefix ++ "Schema")+ entry (raw, ty) =+ TupE+ [ Just (AppE (VarE 'T.pack) (LitE (StringL (T.unpack raw))))+ , Just (schemaTypeE ty)+ ]+ sig <- sigD n [t|Schema|]+ val <-+ valD+ (varP n)+ (normalB (pure (AppE (VarE 'makeSchema) (ListE (map entry specs)))))+ []+ accessors <- fmap concat $ forM specs $ \(raw, ty) -> do+ let an = mkName (accessorName prefix raw)+ asig <- sigD an [t|Expr $(pure ty)|]+ aval <- valD (varP an) (normalB [|col $(TH.lift raw)|]) []+ pure [asig, aval]+ pure (sig : val : accessors)++validatePrefix :: String -> Q ()+validatePrefix prefix = case prefix of+ (c : _) | Char.isLower c || c == '_' -> pure ()+ _ ->+ fail $+ "declareSchemaValues: prefix "+ ++ show prefix+ ++ " must start with a lowercase letter or underscore"++accessorName :: String -> T.Text -> String+accessorName prefix raw =+ prefix ++ upperFirst (camelCase (T.unpack (sanitize raw)))++camelCase :: String -> String+camelCase s = case P.filter (P.not . P.null) (splitOn '_' s) of+ [] -> s+ (w : ws) -> w ++ P.concatMap upperFirst ws++splitOn :: Char -> String -> [String]+splitOn c = P.foldr step [[]]+ where+ step _ [] = []+ step x acc@(cur : rest)+ | x == c = [] : acc+ | otherwise = (x : cur) : rest++upperFirst :: String -> String+upperFirst [] = []+upperFirst (c : cs) = Char.toUpper c : cs
src/DataFrame/Typed/TH/Records.hs view
@@ -4,14 +4,7 @@ {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TypeApplications #-} -{- |-Module : DataFrame.Typed.TH.Records-License : MIT--Record-based typed-API schema derivation. The IO-agnostic core of the-@DataFrame.Typed.TH@ family. CSV-file-based derivation lives in-"DataFrame.Typed.TH.CSV" (in @dataframe-csv-th@).--}+-- | Record-based typed-API schema derivation, the IO-agnostic core. module DataFrame.Typed.TH.Records ( -- * Schema inference from an existing DataFrame value deriveSchema,@@ -46,17 +39,14 @@ import DataFrame.Typed.Record ( HasSchema, Schema,- fromColumns,+ recordsFromFrame,+ recordsToColumns, requireColumn,- toColumns, ) import DataFrame.Typed.Types (TypedDataFrame) import DataFrame.Typed.Util (camelToSnake) -{- | Derive an untyped 'DataFrame.Schema.Schema' value plus per-column 'Expr'-accessors from a record type. The value-level companion to-'deriveSchemaFromType': @$(deriveSchemaValues ''Order)@ generates @orderSchema@.--}+-- | Derive an untyped 'Schema' value and per-column accessors from a record. deriveSchemaValues :: Name -> DecsQ deriveSchemaValues = SchemaTH.deriveSchema @@ -115,13 +105,11 @@ -- | Options controlling 'deriveSchemaFromTypeWith'. data SchemaOptions = SchemaOptions { nameTransform :: String -> String- -- ^ Map each record selector name to a column name. Default: 'camelToSnake'.+ -- ^ Map each selector name to a column name. Default: 'camelToSnake'. , schemaTypeName :: Maybe String- -- ^ Override the generated type synonym name. Default: @\<TypeName\>Schema@.+ -- ^ Override the generated type name. Default: @\<TypeName\>Schema@. , generateInstance :: Bool- {- ^ When @True@ (default), also generate a 'HasSchema' instance so the- record can be turned into a 'DataFrame' via 'fromRecords' / 'toRecords'.- -}+ -- ^ When @True@ (default), also generate a 'HasSchema' instance. } defaultSchemaOptions :: SchemaOptions@@ -211,8 +199,8 @@ [] instType [ schemaInst- , FunD 'toColumns [toClause]- , FunD 'fromColumns [fromClause]+ , FunD 'recordsToColumns [toClause]+ , FunD 'recordsFromFrame [fromClause] ] mkToColumnsClause :: [(String, Name, Type)] -> Q Clause