packages feed

heidi 0.0.0 → 0.1.0

raw patch · 16 files changed

+475/−583 lines, 16 filesdep −doctestdep ~base

Dependencies removed: doctest

Dependency ranges changed: base

Files

README.md view
@@ -12,12 +12,14 @@  This library aims to bridge the gap between Haskell's precise but inflexible type discipline and the dynamic world of dataframes. -If this sounds interesting to you, read on!+More specifically, `heidi` aims to make it easy to analyze collections of Haskell values; users `encode` their data (lists, maps and so on) into dataframes, and use functions provided by `heidi` for manipulation. +If this sounds interesting, read on! + ## Introduction -A "dataframe" is conceptually a table of data that can be manipulated with a computer program; it potentially contains numbers, text and anything else that can be rendered as a string of text.+A "dataframe" is conceptually a table of data that can be manipulated with a computer program; it potentially contains numbers, text and anything else that can be rendered as text.  In scientific practice, a "tidy" dataframe is a specific way of arranging the data in which each row represents a distinct observation ("data point") and each column a "feature" (i.e. some observable aspect) of the data.  @@ -25,19 +27,37 @@  What about Haskell? -## TL;DR+The `Frames` [1] library offers rigorous type safety and good runtime performance, at the cost of some setup overhead. `Heidi`'s  main design goal instead is to have minimal overhead and possibly very low cognitive load to data science practitioners, at the cost of some type safety.  +## Quickstart++The following snippet demonstrates the minimal setup necessary to use `heidi` :+ ```-{-# language DeriveGenerics, DeriveAnyClass #-}+{-# language DeriveGeneric #-}   (1) module MyDataScienceTask where+import GHC.Generics    (2)  import Heidi -data Sales = Row String Int deriving (Eq, Show, Generic, Heidi)+data Sales = Sales { item :: String, amount :: Int } deriving (Eq, Show, Generic)     (3)+instance Heidi Sales     (4) ``` -and off you go.+All datatypes that are meant to be used within dataframes must be in the `Heidi` typeclass, which in turn requires a `Generic` instance. +The `DeriveGeneric` language extension (1) enables the compiler to automatically write the correct incantations (3), as long as the user also imports the `GHC.Generics` module (2) from `base`.++The automatic dataframe encoding mechanism is made possible by the empty `Heidi` instance (4).++It is also convenient to use `DeriveAnyClass` to avoid writing the empty typeclass instance :++```+{-# language DeriveGeneric, DeriveAnyClass #-}+data Foo = Foo Int String deriving (Generic, Heidi)+```++ ## Rationale  @@ -53,7 +73,7 @@  In addition to lookup, many data tasks require relational operations across pairs of data tables; algorithmically, these require lookups both across rows and columns, and there's nothing in Haskell's implementation of records that supports this. -There are a number of additional tasks that are routine in data analysis but not so+There are a number of additional tasks that are routine in data analysis such as plotting, rendering the dataset to various tabular formats (CSV, database ...), and this library aims to support those too with a convenient syntax.   ## Advanced
app/Main.hs view
@@ -13,11 +13,7 @@ -- import qualified Data.HashMap.Strict as HM import qualified Data.Text as T --- import Core.Data.Frame--- import Core.Data.Frame.Generic--- import qualified Heidi.Data.Row.GenericTrie as GTR--- import Data.Generics.Encode.Internal (HasGE, TC, VP)-import Heidi -- (Heidi, Frame, TC, VP, gToFrameGT, filterDecode, mkTyN, mkTyCon)+import Heidi import Heidi.Data.Frame.Algorithms.GenericTrie (innerJoin)  -- import Lens.Micro ((^.), (%~), to, has)
heidi.cabal view
@@ -1,5 +1,5 @@ name:           heidi-version:        0.0.0+version:        0.1.0 synopsis:       Tidy data in Haskell description:    Tidy data in Haskell, via generics. homepage:       https://github.com/ocramz/heidi#readme@@ -27,26 +27,23 @@   exposed-modules:                   Heidi                   Heidi.Data.Frame.Algorithms.GenericTrie-   other-modules:-                  Heidi.Data.Row.GenericTrie-                  +                  Core.Data.Frame+                  Core.Data.Frame.Generic+                  Core.Data.Frame.List+                  Core.Data.Frame.PrettyPrint+                  Core.Data.Row.Internal+                  Data.Generics.Encode.Internal+                  Data.Generics.Encode.Internal.Prim+                  Data.Generics.Encode.OneHot                   Heidi.Data.Frame.Algorithms.GenericTrie.Generic                  -                  Data.Generics.Codec-                  Data.Generics.Encode.OneHot                -                Data.Generics.Encode.Internal-                Data.Generics.Decode-                Core.Data.Frame-                Core.Data.Frame.List                -                Core.Data.Frame.PrettyPrint-                Core.Data.Frame.Generic-                Core.Data.Row.Internal+                  Heidi.Data.Row.GenericTrie   hs-source-dirs:       src   ghc-options: -Wall   build-depends:-                base > 4.9 && < 4.13-              , boxes >= 0.1.4+                    base > 4.9 && < 4.14+                , boxes >= 0.1.4               -- , bytestring >= 0.10.8.1               , containers >= 0.5.7.1               , exceptions >= 0.8.3@@ -85,17 +82,17 @@               -- , hspec-expectations   default-language: Haskell2010 -test-suite doctest-  default-language:    Haskell2010           -  type: exitcode-stdio-1.0-  main-is: DocTest.hs-  hs-source-dirs:-        test-  ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-                heidi-              , base -              , doctest +-- test-suite doctest+--   default-language:    Haskell2010           +--   type: exitcode-stdio-1.0+--   main-is: DocTest.hs+--   hs-source-dirs:+--         test+--   ghc-options: -threaded -rtsopts -with-rtsopts=-N+--   build-depends:+--                 heidi+--               , base +--               , doctest   benchmark bench-space   type: exitcode-stdio-1.0
src/Core/Data/Frame.hs view
@@ -30,8 +30,6 @@   head, take, drop, zipWith, numRows,    -- ** Filtering    filter, -  -- *** 'D.Decode'-based filtering-  filterDecode,    -- **   groupWith,    -- ** Scans (row-wise cumulative operations)@@ -47,9 +45,6 @@   -- insert, insertRowFun, insertRowFunM,    -- -- ** Access   -- toList, keys, elems,-  -- -- *** Decoders-  -- D.Decode, D.mkDecode, D.runDecode, -  -- real, scientific, text, oneHot,    -- -- ** Lookup   -- HMR.lookup, lookupThrowM, lookupDefault, (!:), elemSatisfies,    -- -- ** Set operations@@ -67,29 +62,9 @@  import qualified Control.Monad as CM (filterM) import Data.Maybe (fromMaybe)--- import Control.Applicative (Alternative(..))--- import qualified Data.Foldable as F--- import Data.Foldable (foldl, foldr, foldlM, foldrM) import qualified Data.Vector as V--- import qualified Data.Vector.Generic.Mutable as VGM--- import qualified Data.Vector.Algorithms.Merge as V (sort, sortBy, Comparison)--- import qualified Data.Text as T (pack)--- import Data.Text (Text)--- import qualified Data.Map as M--- import qualified Data.HashMap.Strict as HM import qualified Data.List.NonEmpty as NE --- import Control.Monad.Catch(Exception(..), MonadThrow(..))--- import Data.Scientific (Scientific, toRealFloat)--- import Data.Typeable (Typeable)--import qualified Data.Generics.Decode as D (Decode, runDecode)--- import Data.Generics.Decode ((>>>))--- import qualified Data.GenericTrie as GT--- import Data.Generics.Encode.Internal (VP, getIntM, getFloatM, getDoubleM, getScientificM, getStringM, getTextM, getOneHotM)--- import Data.Generics.Encode.OneHot (OneHot)-- import Prelude hiding (filter, zipWith, lookup, foldl, foldr, scanl, scanr, head, take, drop)  -- $setup@@ -175,18 +150,6 @@            (row -> f Bool) -> Frame row -> f (Maybe (Frame row)) filterA fm t = fromNEList <$> CM.filterM fm (toList t) ----- | Filter a 'Frame' by decoding row values.------ This is an intermediate function that doesn't require fixing the row type within the 'Frame'.------ NB: a 'D.Decode' returning 'Bool' can be declared via its Functor, Applicative and Alternative instances.-filterDecode :: Applicative f =>-                D.Decode f row Bool   -- ^ Row decoder-             -> Frame row-             -> f (Maybe (Frame row))-filterDecode dec = filterA (D.runDecode dec)   -- filterInt2 k1 k2 =
src/Core/Data/Frame/Generic.hs view
@@ -17,8 +17,7 @@ -- ----------------------------------------------------------------------------- module Core.Data.Frame.Generic (-    -- * GenericTrie-based rows-    gToRowGT, encode,+    encode,     -- -- * Exceptions     -- DataException(..)   ) where
src/Core/Data/Frame/PrettyPrint.hs view
@@ -1,36 +1,59 @@-{-# language DeriveFunctor #-}-{-# language DeriveFoldable #-}-{-# language DeriveGeneric #-}-{-# language DeriveTraversable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# language ConstraintKinds #-}+{-# language DeriveAnyClass #-}+{-# language GADTs #-} {-# language LambdaCase #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-} {-# options_ghc -Wno-unused-imports #-}+{-# options_ghc -Wno-unused-top-binds #-} module Core.Data.Frame.PrettyPrint where -import GHC.Generics (Generic(..))+import Data.Proxy (Proxy)+import qualified GHC.Generics as G import qualified Data.Foldable as F (foldl', foldlM)--- import Data.++import Data.Foldable (Foldable(..)) import Data.Function (on)-import Data.List (filter, sortBy, groupBy)+import Data.List (filter, sortBy, groupBy, intersperse)  -- boxes-import Text.PrettyPrint.Boxes (Box, Alignment, emptyBox, nullBox, vcat, hcat, vsep, hsep, text, para, punctuateH, render, printBox, (<>), (<+>), (//), (/+/), top, left, right)+import Text.PrettyPrint.Boxes (Box, Alignment, emptyBox, nullBox, vcat, hcat, vsep, hsep, text, para, punctuateH, render, printBox, (<>), (<+>), (//), (/+/), top, left, right, center1, center2, rows, cols, moveDown)  -- import qualified Data.Text as T+-- containers import qualified Data.Map as M+import Data.Sequence (Seq, (|>), (<|))+-- generic-trie import qualified Data.GenericTrie as GT+-- generics-sop+import Generics.SOP (All, HasDatatypeInfo(..), datatypeInfo, DatatypeName, datatypeName, DatatypeInfo(..), FieldInfo(..), FieldName, fieldName, ConstructorInfo(..), constructorInfo, ConstructorName, constructorName, All(..), All2, hcliftA, hcliftA2, hliftA, hcmap, Proxy(..), SOP(..), NP(..), I(..), K(..), unK, mapIK, hcollapse, SListI, hcpure)+import Generics.SOP.NP (cpure_NP)+-- import Generics.SOP.Constraint (SListIN)+import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)+-- hashable+import Data.Hashable (Hashable(..))+-- unordered-containers+import qualified Data.HashMap.Strict as HM (HashMap, singleton, fromList, toList, union, keys, mapWithKey)  import qualified Core.Data.Frame as CDF-import qualified Core.Data.Frame.Generic as CDF (encode, gToRowGT)-import qualified Heidi.Data.Row.GenericTrie as GTR+import qualified Core.Data.Frame.Generic as CDF (encode)+import Data.Generics.Encode.Internal (Heidi, toVal, Val(..), header, Header(..),  VP(..))+import qualified Data.Generics.Encode.OneHot as OH (OneHot) -import Prelude hiding ((<>))+-- import Prelude hiding ((<>))  {---what's the best data structure for representing this kind of table display?--a trie with strings as keys and lists as values ?- +-------------+-----------------+ | Person      | House           | +-------+-----+-------+---------+@@ -42,134 +65,107 @@ +-------+-----+-------+---------+  (table example from colonnade : https://hackage.haskell.org/package/colonnade-1.2.0.2/docs/src/Colonnade.html#cap )- -}  -{- -fold over a list of tries to update a PTree -[Trie [k] v] -> PTree v -foldl :: Foldable t => (b -> row -> b) -> b -> t row -> b+-- | render the frame header+-- >>> printBox $ headerBox $ header (Proxy @R) -foldWithKey :: GT.TrieKey k => (k -> a -> r -> r) -> r -> Row k a -> r+-- -- headerBox :: Header String -> Box+-- headerBox h0 = go h0 0+--   where+--     go h d =+--       case h of+--         HSum ty hm -> withHM '+' ty hm+--         HProd ty hm -> withHM '*' ty hm+--         HLeaf l -> HLeaf (text l, d) -- fixme depth to be adjusted with 'moveDown'+--       where+--         d' = d + 3 -- depth of deepest rendered layer so far+--         withHM sep ty hm = boxLayer+--           where+--             boxLayer = text ty /|/+--                        dashesWith sep bxs /|/+--                        hSepList bxs+--             bxs = values $ HM.mapWithKey (\k hrest -> text k /|/ go hrest d') hm --} -arr0, arr1 :: [Box]-arr0 = [text "moo", text "123123123"]-arr1 = [text "asdfasdfasdfasdf", text "z"]---- justification is computed per-column by Box-box1 :: Alignment -> Box-box1 aln = hsep 2 top [c0, c1]+headerBox :: Show a => Header a -> Box+headerBox h =+  case h of+      HSum ty hm -> withHM '+' ty hm+      HProd ty hm -> withHM '*' ty hm+      HLeaf l -> text $ show l   where-    c0 = vsep 1 aln arr0-    c1 = vsep 1 aln arr1+    withHM sep ty hm = boxLayer+      where+        boxLayer = text ty /|/+                   dashesWith sep bxs /|/+                   hSepList bxs+        bxs = values $ HM.mapWithKey (\k v -> text k /|/ headerBox v) hm  ---   +-------------+-----------------+---   | Person      | House           |---   +-------+-----+-------+---------+---   | Name  | Age | Color | Price   | -box2 :: Box-box2 = l <+> r-  where-    l = text "Person" // (text "Name" <+> text "Age")-    r = text "House" // (text "Color" <+> text "Price")+values :: HM.HashMap k v -> [v]+values = map snd . HM.toList +dashesWith :: Char -> [Box] -> Box+dashesWith sep bxs = punctuateH top (text [sep]) $  map (\b -> dashes (cols b + n)) bxs+  where n = length bxs - 1 +dashes :: Int -> Box+dashes n = text $ replicate n '-' +hSepList :: [Box] -> Box+hSepList = hcat top . intersperse seph +seph :: Box+seph = text " | " +(/|/) :: Box -> Box -> Box+b1 /|/ b2 = vcat center1 [b1, b2]    -data M k v = Ml v-           | Mb (M.Map k (M k v)) deriving (Functor, Foldable)-instance (Show k, Show v) => Show (M k v) where-  show = \case-    Ml x -> show x-    Mb m -> show $ M.toList m+-- examples -empty :: M k v-empty = Mb M.empty+{-+gshow :: forall a. (Generic a, HasDatatypeInfo a, All2 Show (Code a))+      => a -> String+gshow a =+  gshow' (constructorInfo (datatypeInfo (Proxy :: Proxy a))) (from a) --- | Copy the contents of a list-indexed Row into a tree-shaped structure (for pretty-printing)------ >>> unfold [("aa", 41), ("ab", 42)]--- [('a',[('a',[('a',41)]),('b',42)])]  -- FIXME why 3 levels and not 2 ?!?-unfold :: (Foldable t, Ord k) =>-          t ([k], v) -- each GTR.Row is isomorphic to this parameter-       -> M k v-unfold kvs = foldl insf empty kvs-  where-    insf (Mb acc) (ks, v) = insert acc ks v-    insf _        _       = undefined -- FIXME+gshow' :: (All2 Show xss, SListI xss) => NP ConstructorInfo xss -> SOP I xss -> String+gshow' cs (SOP sop) = hcollapse $ hcliftA2 allp goConstructor cs sop --- | Copy a single list-indexed value into a tree------ >>> insert M.empty "abc" 42--- [('a',[('b',[('c',42)])])]-insert :: Ord k => M.Map k (M k v) -> [k] -> v -> M k v-insert = go+goConstructor :: All Show xs => ConstructorInfo xs -> NP I xs -> K String xs+goConstructor (Constructor n) args =+    K $ intercalate " " (n : args')   where-    go _ [] v = Ml v-    go m (k:ks) v = Mb $ M.insert k (go m ks v) m----- data Tree a = Node {---         rootLabel :: a,         -- ^ label value---         subForest :: [Tree a]   -- ^ zero or more child trees---- unfoldTree :: (b -> (a, [b])) -> b -> Tree a--- unfoldTree f b = let (a, bs) = f b in Node a (unfoldForest f bs)--- --- unfoldForest :: (b -> (a, [b])) -> [b] -> Forest a--- unfoldForest f = map (unfoldTree f)----- boxM (Ml s) = text s--- boxM (Mb mm) = foldl ins nullBox mm---   where---     ins acc x = acc <+> boxM x------ >>> groupSort ["aa", "ab", "cab", "xa", "cx"]--- [["aa","ab"],["cab","cx"],["xa"]]-groupSort :: Ord a => [[a]] -> [[[a]]]-groupSort = groupSortBy head--groupSortBy :: Ord a1 => (a2 -> a1) -> [a2] -> [[a2]]-groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)+    args' :: [String]+    args' = hcollapse $ hcliftA p (K . show . unI) args --- render a column of a frame-columnBox :: (Foldable t, Show a, GT.TrieKey k) =>-             t (GTR.Row k a) -- ^ dataframe-          -> k -- ^ column key-          -> Box-columnBox rows k = foldl ins nullBox rows+goConstructor (Record n ns) args =+    K $ n ++ " {" ++ intercalate ", " args' ++ "}"   where-    ins acc row = acc // maybe (emptyBox 1 0) (text . show) (GTR.lookup k row)--------- | union of the set of keys across all rows-allKeys :: (GT.TrieKey k, Foldable f) => f (GTR.Row k v) -> [k]-allKeys = GTR.keys . GTR.keysOnly-+    args' :: [String]+    args' = hcollapse $ hcliftA2 p goField ns args +goConstructor (Infix n _ _) (arg1 :* arg2 :* Nil) =+    K $ show arg1 ++ " " ++ show n ++ " " ++ show arg2+#if __GLASGOW_HASKELL__ < 800+goConstructor (Infix _ _ _) _ = error "inaccessible"+#endif +goField :: Show a => FieldInfo a -> I a -> K String a+goField (FieldInfo field) (I a) = K $ field ++ " = " ++ show a --- data Sized a = Sized !Int a+p :: Proxy Show+p = Proxy --- annotateWithDepth :: (GT.TrieKey k) => GTR.Row [k] a -> GTR.Row [k] (Sized a)--- annotateWithDepth = GTR.mapWithKey (\k v -> Sized (length k) v)+allp :: Proxy (All Show)+allp = Proxy+-}
− src/Data/Generics/Codec.hs 
@@ -1,133 +0,0 @@-{-# options_ghc -Wno-unused-imports #-}-{-# options_ghc -Wno-unused-top-binds #-}-{-# options_ghc -Wno-type-defaults #-}-module Data.Generics.Codec (-  realM, scientificM, textM, stringM, oneHotM, int, int8, int16, int32, int64, word, word8, word16, word32, word64, -  -- * TC (Type and Constructor annotation)-  TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon-  -- * Exceptions-  , TypeError(..)) where--import Control.Applicative (Alternative(..))--import Control.Monad.Catch (MonadThrow(..))--import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word, Word8, Word16, Word32, Word64)---- scientific-import Data.Scientific (Scientific, toRealFloat, fromFloatDigits)--- text-import qualified Data.Text as T---import Data.Generics.Encode.Internal (VP(..), getIntM, getInt8M, getInt16M, getInt32M, getInt64M, getWordM, getWord8M, getWord16M, getWord32M, getWord64M, getBoolM, getFloatM, getDoubleM, getScientificM, getCharM, getStringM, getTextM, getOneHotM, TypeError(..), TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon)-import Data.Generics.Decode (Decode, mkDecode)-import Data.Generics.Encode.OneHot (OneHot)--------- decInt :: D.Decode Maybe VP Int--- decInt = D.mkDecode getInt--- -- decInteger = D.mkDecode getInteger--- decDouble :: D.Decode Maybe VP Double--- decDouble = D.mkDecode getDouble--- -- decChar = D.mkDecode getChar--- -- decText = D.mkDecode getText---- | Decode any real numerical value (integer, double, float or 'Scientific') into a Double-realM :: (Alternative m, MonadThrow m) => Decode m VP Double-realM =-  (fromIntegral <$> int)     <|>-  double                     <|>-  (realToFrac <$> float)     <|>-  (toRealFloat <$> scientific) ---- | Decode any real numerical value (integer, double, float or 'Scientific') into a Scientific-scientificM :: (Alternative m, MonadThrow m) => Decode m VP Scientific-scientificM =-  scientific <|>-  (fromFloatDigits . fromIntegral <$> int) <|>-  (fromFloatDigits <$> double)             <|>-  (fromFloatDigits <$> float)---- | Decode a string ('String' or 'Text') into a Text-textM :: (Alternative m, MonadThrow m) => Decode m VP T.Text-textM =-  (T.pack <$> string) <|>-  text---- | Decode a string ('String' or 'Text') into a String-stringM :: (Alternative m, MonadThrow m) => Decode m VP String-stringM =-  string <|>-  (T.unpack <$> text)-------- | Decode a one-hot value-oneHotM :: MonadThrow m => Decode m VP (OneHot Int)-oneHotM = mkDecode getOneHotM------int :: MonadThrow m => Decode m VP Int-int = mkDecode getIntM--int8 :: MonadThrow m => Decode m VP Int8-int8 = mkDecode getInt8M--int16 :: MonadThrow m => Decode m VP Int16-int16 = mkDecode getInt16M--int32 :: MonadThrow m => Decode m VP Int32-int32 = mkDecode getInt32M--int64 :: MonadThrow m => Decode m VP Int64-int64 = mkDecode getInt64M--word :: MonadThrow m => Decode m VP Word-word = mkDecode getWordM--word8 :: MonadThrow m => Decode m VP Word8-word8 = mkDecode getWord8M--word16 :: MonadThrow m => Decode m VP Word16-word16 = mkDecode getWord16M--word32 :: MonadThrow m => Decode m VP Word32-word32 = mkDecode getWord32M--word64 :: MonadThrow m => Decode m VP Word64-word64 = mkDecode getWord64M--bool :: MonadThrow m => Decode m VP Bool-bool = mkDecode getBoolM--float :: MonadThrow m => Decode m VP Float-float = mkDecode getFloatM--double :: MonadThrow m => Decode m VP Double-double = mkDecode getDoubleM--scientific :: MonadThrow m => Decode m VP Scientific-scientific = mkDecode getScientificM--char :: MonadThrow m => Decode m VP Char-char = mkDecode getCharM--string :: MonadThrow m => Decode m VP String-string = mkDecode getStringM--text :: MonadThrow m => Decode m VP T.Text-text = mkDecode getTextM---
− src/Data/Generics/Decode.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE-    DeriveFunctor,-    GeneralizedNewtypeDeriving-#-}-{-# OPTIONS_GHC -Wall #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Generics.Decode--- Description :  Composable decoding of terms--- Copyright   :  (c) Marco Zocca (2019)--- License     :  MIT--- Maintainer  :  ocramz fripost org--- Stability   :  experimental--- Portability :  GHC------ Composable decoding of terms-------------------------------------------------------------------------------module Data.Generics.Decode (Decode, mkDecode, runDecode, (>>>)) where--import Control.Applicative      (Alternative(..))-import Control.Category (Category(..)) --- import Data.Foldable (Foldable(..), asum)-import Control.Monad ((>=>))--- import           Data.Maybe               (fromMaybe)--- import Control.Monad.Log (MonadLog(..), Handler, WithSeverity(..), Severity, logDebug, logInfo, logWarning, logError, runLoggingT, PureLoggingT(..), runPureLoggingT)--- import Control.Monad.Trans.State.Strict (StateT(..), runStateT)--import Prelude hiding ((.))----- | We can decouple lookup and value conversion and have distinct error behaviour.--- Multiple value decoding functions can be combined via the Applicative and Alternative instance.------ Note : 'Decode' is called Kleisli in base.Control.Arrow; among other things it has a Profunctor instance.--newtype Decode m i o = Decode { runDecode_ :: i -> m o } deriving (Functor)---- | Run a decoding function-runDecode :: Decode m i o -> i -> m o-runDecode = runDecode_---- | Construct a 'Decode' from a monadic arrow.-mkDecode :: (i -> m o) -> Decode m i o-mkDecode = Decode--instance Applicative m => Applicative (Decode m i) where-  pure x = Decode $ \ _ -> pure x-  Decode af <*> Decode aa = Decode $ \ v -> af v <*> aa v--instance Alternative m => Alternative (Decode m i) where-  empty = Decode $ const empty-  Decode p <|> Decode q = Decode $ \v -> p v <|> q v---- | This instance is copied from @Kleisli@ (defined in Control.Arrow)-instance Monad m => Category (Decode m) where-  id = Decode return-  (Decode f) . (Decode g) = Decode (g >=> f)---- | Left-to-right composition------ @(>>>) :: Monad m => Decode m a b -> Decode m b c -> Decode m a c@-(>>>) :: Category cat => cat a b -> cat b c -> cat a c-(>>>) = flip (.)-{-# inline (>>>) #-}------- data Spork m a b = Spork (a -> m b) (b -> m a) deriving (Functor)------- | [NOTE Key lookup + value conversion, behaviour of row functions ]------ If the key is not found /or/ the conversion fails, use a default; the first exception thrown by the lookup-and-convert function will be rethrown.--- We'd like instead to try many different decoders, and only throw if /all/ have failed--- --- How should Alternative behave for lookup-and-convert that both might fail?--- --- value decoding : try all decoders, return first successful (== Alternative)--- decoding missing values : should be configurable--- -- * use default value--- -- * skip rows that have any missing value--- --- row function: decoding behaviour should be defined for all function arguments------ example : ------ λ> bool (2 :: Int) (VBool False) <|> bool (2 :: Int) (VBool True)--- False--- λ> bool (2 :: Int) (VDouble 32) <|> bool (2 :: Int) (VBool True)--- *** Exception: ValueTypeError 2 VTypeBool (VDouble 32.0)------ λ> Nothing <|> pure 32.0--- Just 32.0--- λ> (bool (2 :: Int) (VDouble 32) <|> bool (2 :: Int) (VBool True)) :: Maybe Bool--- Just True------ ^ throwM in IO : strict (the first failing decoder throws an exception), Maybe : lazy (keeps trying decoders and returns the first successful one)
src/Data/Generics/Encode/Internal.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# language     DeriveGeneric+  , DeriveAnyClass   , DeriveDataTypeable   , FlexibleContexts   , GADTs@@ -9,10 +13,12 @@   , FlexibleInstances   , LambdaCase   , TemplateHaskell+  , TypeApplications #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wno-type-defaults #-}--- {-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# options_ghc -Wno-unused-imports #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Generics.Encode.Internal@@ -41,17 +47,21 @@                                      -- * TC (Type and Constructor annotation)                                      TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon,                                       -- * Heidi (generic ADT encoding)-                                     Heidi) where+                                     Heidi, toVal, Val(..), header, Header(..)) where  import qualified GHC.Generics as G import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.Proxy import Data.Typeable (Typeable) +-- containers+import qualified Data.Map as M (Map, fromList, insert, lookup)+import Data.Sequence (Seq, (|>), (<|)) -- exceptions import Control.Monad.Catch(Exception(..), MonadThrow(..)) -- generics-sop-import Generics.SOP (All, DatatypeName, datatypeName, DatatypeInfo, FieldInfo(..), FieldName, ConstructorInfo(..), constructorInfo, All, All2, hcliftA2, hcmap, Proxy(..), SOP(..), NP(..), I(..), K(..), mapIK, hcollapse)+import Generics.SOP (All, HasDatatypeInfo(..), datatypeInfo, DatatypeName, datatypeName, DatatypeInfo, FieldInfo(..), SListI, FieldName, ConstructorInfo(..), constructorInfo, All, All2, AllN, Prod, HAp, hcpure, hmap, hcliftA, hcliftA2, hcmap, Proxy(..), SOP(..), NP(..), I(..), K(..), mapIK, hcollapse) -- import Generics.SOP.NP (cpure_NP) -- import Generics.SOP.Constraint (SListIN) import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)@@ -68,11 +78,11 @@  -- import Data.Time (Day, LocalTime, TimeOfDay) -- import qualified Data.Vector as V--- import qualified Data.Map as M import qualified Data.HashMap.Strict as HM -- import qualified Data.GenericTrie as GT  import Data.Generics.Encode.OneHot (OneHot, mkOH)+import Data.Generics.Encode.Internal.Prim (VP(..), vpInt, vpScientific, vpFloat, vpDouble, vpString, vpChar, vpText, vpBool, vpOneHot) -- import Data.List (unfoldr) -- import qualified Data.Foldable as F -- import qualified Data.Sequence as S (Seq(..), empty)@@ -84,52 +94,7 @@ -- >>> :set -XDeriveGeneric -- >>> import qualified GHC.Generics as G --- | Primitive types------ NB : this is just a convenience for unityping the dataframe contents, but it should not be exposed to the library users -data VP =-     VPInt    { _vpInt :: Int }    -- ^ 'Int'-   | VPInt8   Int8  -- ^ 'Int8'-   | VPInt16   Int16  -- ^ 'Int16'-   | VPInt32   Int32 -- ^ 'Int32'-   | VPInt64   Int64 -- ^ 'Int64'-   | VPWord   Word   -- ^ 'Word'-   | VPWord8   Word8  -- ^ 'Word8'-   | VPWord16   Word16 -- ^ 'Word16'-   | VPWord32   Word32 -- ^ 'Word32'-   | VPWord64   Word64   -- ^ 'Word64'-   | VPBool   { _vpBool :: Bool } -- ^ 'Bool'-   | VPFloat  { _vpFloat :: Float } -- ^ 'Float'-   | VPDouble { _vpDouble :: Double } -- ^ 'Double'-   | VPScientific { _vpScientific :: Scientific } -- ^ 'Scientific'-   | VPChar   { _vpChar :: Char } -- ^ 'Char'-   | VPString { _vpString :: String } -- ^ 'String'-   | VPText   { _vpText :: Text } -- ^ 'Text'-   | VPOH     { _vpOneHot :: OneHot Int }  -- ^ 1-hot encoding of an enum value-   deriving (Eq, Ord, G.Generic)-instance Hashable VP-makeLenses ''VP -instance Show VP where-  show = \case-    VPInt x -> show x-    VPInt8 x -> show x-    VPInt16 x -> show x-    VPInt32 x -> show x-    VPInt64 x -> show x-    VPWord x -> show x-    VPWord8 x -> show x-    VPWord16 x -> show x-    VPWord32 x -> show x-    VPWord64 x -> show x-    VPBool b   -> show b-    VPFloat f -> show f-    VPDouble d -> show d-    VPScientific s -> show s-    VPChar d -> pure d-    VPString s -> s-    VPText t -> unpack t-    VPOH oh -> show oh   -- | Flatten a value into a 1-layer hashmap, via the value's generic encoding@@ -185,19 +150,14 @@     VPrim vp       -> insRev ks vp hmacc  ---- flatten' z insf = go ([], z) where---   insRev ks = insf (reverse ks)---   go (ks, hmacc) = \case---     VRec ty hm     -> HM.foldlWithKey' (\hm' k t -> go (TC ty k : ks, hm') t) hmacc hm---     -- VEnum ty cn oh -> insRev (TC ty cn : ks) (VPOH oh) hmacc---     -- VPrim vp       -> insRev ks vp hmacc------+-- | Collect the hashmap keys at the leaves. The resulting lists at the leaf nodes can be used to look up values in the rows+collectKeys :: Header String -> Header (Seq String)+collectKeys = go mempty+  where+    go acc = \case+      HLeaf x -> HLeaf (acc |> x)+      HSum ty hm -> HSum ty $ HM.mapWithKey (\k v -> go (acc |> k) v) hm+      HProd ty hm -> HProd ty $ HM.mapWithKey (\k v -> go (acc |> k)  v) hm   -- | Internal representation of encoded ADTs values@@ -209,27 +169,39 @@    | VPrim  VP                                    -- ^ primitive types    deriving (Eq, Show) +-- the type param 't' can store information at the leaves, e.g. list-shaped keys for lookup+data Header t =+     HSum String (HM.HashMap String (Header t)) -- ^ sums+   | HProd String (HM.HashMap String (Header t)) -- ^ products+   | HLeaf t -- ^ primitive types+   deriving (Eq, Show, Functor, Foldable, Traversable) --- | Typeclass for types which have a generic encoding.+-- | Single interface to the library. ----- NOTE: if your type has a 'G.Generic' instance you just need to declare an empty instance of 'Heidi' for it.+-- This typeclass provides all the machinery for encoding Haskell values into dataframes. --+-- NOTE: Your datatypes only need to possess a 'G.Generic' instance, to which you just need to add an empty instance of 'Heidi'.+-- -- example: -- -- @--- data A = A Int Char deriving ('G.Generic')--- instance 'Heidi' A+-- {-\# language DeriveGenerics, DeriveAnyClass \#-}+--+-- data A = A Int Char deriving ('G.Generic', 'Heidi') -- @ class Heidi a where   toVal :: a -> Val   default toVal ::     (G.Generic a, All2 Heidi (GCode a), GFrom a, GDatatypeInfo a) => a -> Val-  toVal x = sopHeidi (gdatatypeInfo (Proxy :: Proxy a)) (gfrom x)  -+  toVal x = toVal' (gdatatypeInfo (Proxy :: Proxy a)) (gfrom x)+  header :: Proxy a -> Header String+  default header ::+    (G.Generic a, All2 Heidi (GCode a), GDatatypeInfo a) => Proxy a -> Header String+  header _ = header' (gdatatypeInfo (Proxy :: Proxy a)) -sopHeidi :: All2 Heidi xss => DatatypeInfo xss -> SOP I xss -> Val-sopHeidi di sop@(SOP xss) = hcollapse $ hcliftA2-    (Proxy :: Proxy (All Heidi))+toVal' :: All2 Heidi xss => DatatypeInfo xss -> SOP I xss -> Val+toVal' di sop@(SOP xss) = hcollapse $ hcliftA2+    allp     (\ci xs -> K (mkVal ci xs tyName oneHot))     (constructorInfo di)     xss@@ -238,7 +210,9 @@      oneHot = mkOH di sop  mkVal :: All Heidi xs =>-         ConstructorInfo xs -> NP I xs -> DatatypeName -> OneHot Int -> Val+         ConstructorInfo xs+      -> NP I xs+      -> DatatypeName -> OneHot Int -> Val mkVal cinfo xs tyn oh = case cinfo of     Infix cn _ _  -> VRec cn $ mkAnonProd xs     Constructor cn@@ -247,49 +221,116 @@     Record _ fi   -> VRec tyn $ mkProd fi xs   where     cns :: [Val]-    cns = npHeidis xs+    cns = npToVals xs -mkProd :: All Heidi xs => NP FieldInfo xs -> NP I xs -> HM.HashMap String Val-mkProd fi xs = HM.fromList $ hcollapse $ hcliftA2 (Proxy :: Proxy Heidi) mk fi xs where-  mk :: Heidi v => FieldInfo v -> I v -> K (FieldName, Val) v-  mk (FieldInfo n) (I x) = K (n, toVal x)+    mkProd :: All Heidi xs => NP FieldInfo xs -> NP I xs -> HM.HashMap String Val+    mkProd finfo xss = HM.fromList $+      hcollapse $ hcliftA2 p mk finfo xss+      where+        mk :: Heidi v => FieldInfo v -> I v -> K (FieldName, Val) v+        mk (FieldInfo n) (I x) = K (n, toVal x) -mkAnonProd :: All Heidi xs => NP I xs -> HM.HashMap String Val-mkAnonProd xs = HM.fromList $ zip labels cns where-  cns = npHeidis xs+    mkAnonProd :: All Heidi xs => NP I xs -> HM.HashMap String Val+    mkAnonProd xss = HM.fromList $ zip labels cnss+      where+        cnss = npToVals xss -npHeidis :: All Heidi xs => NP I xs -> [Val]-npHeidis xs = hcollapse $ hcmap (Proxy :: Proxy Heidi) (mapIK toVal) xs+npToVals :: All Heidi xs => NP I xs -> [Val]+npToVals xs = hcollapse $ hcmap p (mapIK toVal) xs ++header' :: (All2 Heidi xs, SListI xs) => DatatypeInfo xs -> Header String+header' di+  | single hs =+      let (n, hdr) = head hs+      in HProd dtn $ HM.singleton n hdr+  | otherwise = HSum dtn $ HM.fromList hs+  where+    hs :: [(String, Header String)]+    hs = hcollapse $ hcliftA allp (goConstructor dtn) cinfo+    cinfo = constructorInfo di+    dtn = datatypeName di++goConstructor :: forall xs . (All Heidi xs) => String -> ConstructorInfo xs -> K (String, Header String) xs+goConstructor dtn = \case+  Record n ns -> K (n, mkProdH dtn ns)+  Constructor n -> K (n, mkAnonProdH dtn (Proxy @xs) )+  Infix n _ _ -> K (n, mkAnonProdH dtn (Proxy @xs) )+++-- | anonymous products+mkAnonProdH ::+  forall xs. (SListI xs, All Heidi xs) => String -> Proxy xs -> Header String+mkAnonProdH dtn _  | single hs =+                    let hdr = head hs+                    in hdr+                  | null hs = HLeaf dtn+                  | otherwise = HProd dtn $ HM.fromList $ zip labels hs+  where+    hs :: [Header String]+    hs = hcollapse (hcpure p headerK :: NP (K (Header String)) xs)+    headerK :: forall a. Heidi a => K (Header String) a+    headerK = K (header (Proxy @a))++-- | products+mkProdH :: All Heidi xs => String -> NP FieldInfo xs -> Header String+mkProdH dtn finfo | single hs =+                    let (n, hdr) = head hs   -- FIXME why n is unused ?!+                    in hdr+                 | otherwise = HProd dtn $ HM.fromList hs+  where+    hs :: [(String, Header String)]+    hs = hcollapse $ hcliftA p goFieldH finfo++goFieldH :: forall a . (Heidi a) => FieldInfo a -> K (String, Header String) a+goFieldH (FieldInfo n) = goFieldAnonH n++goFieldAnonH :: forall a . Heidi a => String -> K (String, Header String) a+goFieldAnonH n = K (n, header (Proxy @a))++single :: [a] -> Bool+single = (== 1) . length+++allp :: Proxy (All Heidi)+allp = Proxy++p :: Proxy Heidi+p = Proxy+ -- | >>> take 3 labels -- ["_0","_1","_2"] labels :: [String] labels = map (('_' :) . show) [0 ..]  --- instance Heidi () where toVal = VPrim VUnit+instance Heidi () where {toVal _ = VPrim VPUnit ; header _ = HLeaf "()"} instance Heidi Bool where toVal = VPrim . VPBool-instance Heidi Int where toVal = VPrim . VPInt-instance Heidi Int8 where toVal = VPrim . VPInt8-instance Heidi Int16 where toVal = VPrim . VPInt16-instance Heidi Int32 where toVal = VPrim . VPInt32-instance Heidi Int64 where toVal = VPrim . VPInt64-instance Heidi Word8 where toVal = VPrim . VPWord8-instance Heidi Word16 where toVal = VPrim . VPWord16-instance Heidi Word32 where toVal = VPrim . VPWord32-instance Heidi Word64 where toVal = VPrim . VPWord64-instance Heidi Float where toVal = VPrim . VPFloat-instance Heidi Double where toVal = VPrim . VPDouble-instance Heidi Scientific where toVal = VPrim . VPScientific-instance Heidi Char where toVal = VPrim . VPChar-instance Heidi String where toVal = VPrim . VPString-instance Heidi Text where toVal = VPrim . VPText+instance Heidi Int where {toVal = VPrim . VPInt ; header _ = HLeaf "Int"}+instance Heidi Int8 where {toVal = VPrim . VPInt8 ; header _ = HLeaf "Int8"}+instance Heidi Int16 where {toVal = VPrim . VPInt16 ; header _ = HLeaf "Int16"}+instance Heidi Int32 where {toVal = VPrim . VPInt32 ; header _ = HLeaf "Int32"}+instance Heidi Int64 where {toVal = VPrim . VPInt64 ; header _ = HLeaf "Int64"}+instance Heidi Word where {toVal = VPrim . VPWord ; header _ = HLeaf "Word"}+instance Heidi Word8 where {toVal = VPrim . VPWord8 ; header _ = HLeaf "Word8"}+instance Heidi Word16 where {toVal = VPrim . VPWord16 ; header _ = HLeaf "Word16"}+instance Heidi Word32 where {toVal = VPrim . VPWord32 ; header _ = HLeaf "Word32"}+instance Heidi Word64 where {toVal = VPrim . VPWord64 ; header _ = HLeaf "Word64"}+instance Heidi Float where {toVal = VPrim . VPFloat ; header _ = HLeaf "Float"}+instance Heidi Double where {toVal = VPrim . VPDouble ; header _ = HLeaf "Double"}+instance Heidi Scientific where {toVal = VPrim . VPScientific ; header _ = HLeaf "Scientific"}+instance Heidi Char where {toVal = VPrim . VPChar ; header _ = HLeaf "Char"}+instance Heidi String where {toVal = VPrim . VPString ; header _ = HLeaf "String"}+instance Heidi Text where {toVal = VPrim . VPText ; header _ = HLeaf "Text"}  instance Heidi a => Heidi (Maybe a) where   toVal = \case     Nothing -> VRec "Maybe" HM.empty     Just x  -> VRec "Maybe" $ HM.singleton "Just" $ toVal x-  +  header _ = HSum "Maybe" $ HM.fromList [+    ("Nothing", HLeaf "_") ,+    ("Just", header (Proxy @a))]+ instance (Heidi a, Heidi b) => Heidi (Either a b) where   toVal = \case     Left  l -> VRec "Either" $ HM.singleton "Left" $ toVal l@@ -433,22 +474,20 @@  -- -- examples --- data A0 = A0 deriving (Eq, Show, G.Generic)--- instance Heidi A0--- newtype A = A Int deriving (Eq, Show, G.Generic)--- instance Heidi A--- newtype A2 = A2 { a2 :: Int } deriving (Eq, Show, G.Generic)--- instance Heidi A2--- data B = B Int Char deriving (Eq, Show, G.Generic)--- instance Heidi B--- data B2 = B2 { b21 :: Int, b22 :: Char } deriving (Eq, Show, G.Generic)--- instance Heidi B2--- data C = C1 | C2 | C3 deriving (Eq, Show, G.Generic)--- instance Heidi C--- data D = D (Maybe Int) (Either Int String) deriving (Eq, Show, G.Generic)--- instance Heidi D--- data E = E (Maybe Int) (Maybe Char) deriving (Eq, Show, G.Generic)--- instance Heidi E+data A0 = MkA0 deriving (Eq, Show, G.Generic, Heidi)+data A = MkA Int deriving (Eq, Show, G.Generic, Heidi)+newtype A' = MkA' Int deriving (Eq, Show, G.Generic, Heidi)+newtype A2 = A2 { a2 :: Int } deriving (Eq, Show, G.Generic, Heidi)+data B = MkB Int Char deriving (Eq, Show, G.Generic, Heidi)+data B2 = MkB2 { b21 :: Int, b22 :: Char } deriving (Eq, Show, G.Generic, Heidi)+data C = MkC1 {c1 :: Int} | MkC2 A | MkC3 () deriving (Eq, Show, G.Generic, Heidi)+data C2 = C21 {c21a :: Int, c21b :: ()} | C22 {c22 :: A} | C23 () deriving (Eq, Show, G.Generic, Heidi)+data C3 = C31 | C32 | C33 deriving (Eq, Show, G.Generic, Heidi)+-- data C3 a = C31 a a deriving (Eq, Show, G.Generic, Heidi)+data D = D (Maybe Int) C deriving (Eq, Show, G.Generic, Heidi)+data E = E (Maybe Int) (Maybe Char) deriving (Eq, Show, G.Generic, Heidi)+data R = MkR { r1 :: B2, r2 :: C , r3 :: B } deriving (Eq, Show, G.Generic, Heidi)+ -- newtype F = F (Int, Char) deriving (Eq, Show, G.Generic) -- instance Heidi F
+ src/Data/Generics/Encode/Internal/Prim.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# language TemplateHaskell #-}+{-# options_ghc -Wno-unused-imports #-}+module Data.Generics.Encode.Internal.Prim (VP(..), vpInt, vpBool, vpFloat, vpDouble, vpScientific, vpChar, vpString, vpText, vpOneHot) where++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import qualified GHC.Generics as G++-- hashable+import Data.Hashable (Hashable(..))+-- microlens-th+import Lens.Micro.TH (makeLenses)+-- scientific+import Data.Scientific (Scientific)+-- text+import Data.Text (Text, unpack)++import Data.Generics.Encode.OneHot (OneHot, mkOH)++-- | Primitive types+--+-- NB : this is just a convenience for unityping the dataframe contents, but it should not be exposed to the library users +data VP =+     VPInt    { _vpInt :: Int }    -- ^ 'Int'+   | VPInt8   Int8  -- ^ 'Int8'+   | VPInt16   Int16  -- ^ 'Int16'+   | VPInt32   Int32 -- ^ 'Int32'+   | VPInt64   Int64 -- ^ 'Int64'+   | VPWord   Word   -- ^ 'Word'+   | VPWord8   Word8  -- ^ 'Word8'+   | VPWord16   Word16 -- ^ 'Word16'+   | VPWord32   Word32 -- ^ 'Word32'+   | VPWord64   Word64   -- ^ 'Word64'+   | VPBool   { _vpBool :: Bool } -- ^ 'Bool'+   | VPFloat  { _vpFloat :: Float } -- ^ 'Float'+   | VPDouble { _vpDouble :: Double } -- ^ 'Double'+   | VPScientific { _vpScientific :: Scientific } -- ^ 'Scientific'+   | VPChar   { _vpChar :: Char } -- ^ 'Char'+   | VPString { _vpString :: String } -- ^ 'String'+   | VPText   { _vpText :: Text } -- ^ 'Text'+   | VPOH     { _vpOneHot :: OneHot Int }  -- ^ 1-hot encoding of an enum value+   | VPUnit+   deriving (Eq, Ord, G.Generic)+instance Hashable VP+makeLenses ''VP++instance Show VP where+  show = \case+    VPInt x -> show x+    VPInt8 x -> show x+    VPInt16 x -> show x+    VPInt32 x -> show x+    VPInt64 x -> show x+    VPWord x -> show x+    VPWord8 x -> show x+    VPWord16 x -> show x+    VPWord32 x -> show x+    VPWord64 x -> show x+    VPBool b   -> show b+    VPFloat f -> show f+    VPDouble d -> show d+    VPScientific s -> show s+    VPChar d -> pure d+    VPString s -> s+    VPText t -> unpack t+    VPOH oh -> show oh+    VPUnit -> show ()
src/Data/Generics/Encode/OneHot.hs view
@@ -3,7 +3,7 @@ -- | -- Module      :  Data.Generics.Encode.OneHot -- Description :  Generic 1-hot encoding of enumeration types --- Copyright   :  (c) Marco Zocca (2019)+-- Copyright   :  (c) Marco Zocca (2019-2020) -- License     :  MIT -- Maintainer  :  ocramz fripost org -- Stability   :  experimental
src/Heidi.hs view
@@ -10,10 +10,8 @@ -- -- Heidi : tidy data in Haskell ----- In Heidi, a data 'Frame' is not meant to be constructed directly, but 'encode'd from a--- collection of values. The encoding produces a simple representation which can be easily manipulated for common data analysis tasks.+-- The purpose of this library is to make it easy to analyze collections of Haskell values; users 'encode' their data collections (lists, maps and so on) into dataframes, and use functions provided by `heidi` for manipulation. -----  -- ----------------------------------------------------------------------------- {-# options_ghc -Wno-unused-imports #-}@@ -39,23 +37,23 @@   , spreadWith, gatherWith   -- * Relational operations   , groupBy, innerJoin, leftOuterJoin-  -- ** Vector-related+  -- * Vector-related   , toVector, fromVector    -- * Row   , Row-  -- * Construction+  -- ** Construction   , rowFromList   -- ** Access   , toList, keys-  -- * Filtering+  -- ** Filtering   , delete, filterWithKey, filterWithKeyPrefix, filterWithKeyAny   , deleteMany-  -- * Partitioning+  -- ** Partitioning   , partitionWithKey, partitionWithKeyPrefix   -- -- ** Decoders   -- , real, scientific, text, string, oneHot-  -- * Lookup+  -- ** Lookup   , lookup   -- , lookupThrowM   , (!:), elemSatisfies@@ -64,24 +62,29 @@   -- ** Comparison by lookup   , eqByLookup, eqByLookups   , compareByLookup-  -- * Set operations+  -- ** Set operations   , union, unionWith   , intersection, intersectionWith-  -- * Maps+  -- ** Maps   , mapWithKey-  -- * Folds+  -- ** Folds   , foldWithKey, keysOnly-  -- * Traversals+  -- ** Traversals   , traverseWithKey-  -- * Lenses-  , int, bool, float, double, char, string, text, scientific, oneHot   -- ** Lens combinators+  -- *** Traversals+  , int, bool, float, double, char, string, text, scientific, oneHot+  -- *** Getters+  , real, txt+  -- , flag+  -- *** Combinators   , at, keep-  -- *** Combinators for list-indexed rows+  -- **** Combinators for list-indexed rows   , atPrefix, eachPrefixed, foldPrefixed   -- ** Encode internals   , tcTyN, tcTyCon, mkTyN, mkTyCon   -- , DataException(..)+  , OneHot   )   where @@ -89,9 +92,8 @@  import Core.Data.Frame.List (Frame, frameFromList, head, take, drop, zipWith, numRows, filter, filterA, groupWith, scanl, scanr, toVector, fromVector) import Core.Data.Frame.Generic (encode)-import Data.Generics.Encode.Internal (Heidi, VP(..))--- import qualified Data.Generics.Decode as D (Decode, runDecode)-import Data.Generics.Codec (TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon, TypeError(..))+import Data.Generics.Encode.Internal (Heidi(..), VP(..), getIntM, getInt8M, getInt16M, getInt32M, getInt64M, getWordM, getWord8M, getWord16M, getWord32M, getWord64M, getBoolM, getFloatM, getDoubleM, getScientificM, getCharM, getStringM, getTextM, getOneHotM, TypeError(..), TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon)+import Data.Generics.Encode.OneHot (OneHot) import Heidi.Data.Row.GenericTrie  import Heidi.Data.Frame.Algorithms.GenericTrie (innerJoin, leftOuterJoin, gatherWith, spreadWith, groupBy)
src/Heidi/Data/Row/GenericTrie.hs view
@@ -55,20 +55,25 @@   , foldWithKey, keysOnly   -- * Traversals   , traverseWithKey-  -- * Lenses+  -- * Lens combinators+  -- ** Traversals   , int, bool, float, double, char, string, text, scientific, oneHot-  -- ** Lens combinators+  -- ** Getters+  , real, txt+  -- , flag+  -- ** Combinators   , at, keep   -- *** Combinators for list-indexed rows   , atPrefix, eachPrefixed, foldPrefixed   ) where --- import Control.Monad (foldM+import qualified Control.Applicative as A (empty)+import Control.Applicative ((<|>)) import Data.Functor.Const (Const(..)) import Data.Functor.Identity (Identity(..)) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe)-import Data.Monoid (Any(..), All(..))+import Data.Monoid (Any(..), All(..), First(..)) -- import Data.Semigroup (Endo) -- import Data.Typeable (Typeable) -- import Control.Applicative (Alternative(..))@@ -79,13 +84,14 @@ -- exceptions -- import Control.Monad.Catch (MonadThrow(..)) -- microlens-import Lens.Micro (Lens', Traversal', Getting, (^.), (<&>), _Just, Getting, traversed, folded, to, has)+import Lens.Micro (Lens', Traversal', Getting, (^.), (^?), (<&>), _Just, Getting, traversed, folded, to, has, (.~), failing) -- -- microlens-th -- import Lens.Micro.TH (makeLenses) -- scientific import Data.Scientific (Scientific) -- text import Data.Text (Text)+import qualified Data.Text as T (pack, unpack)   -- import qualified Data.Generics.Decode as D (Decode, mkDecode)@@ -121,7 +127,11 @@   r1 <= r2 = F.toList r1 <= F.toList r2  -- | Focus on a given column-at :: GT.TrieKey k => k -> Lens' (Row k a) (Maybe a)+--+-- NB : setting a 'Nothing' value removes the entry+at :: GT.TrieKey k =>+      k -- ^ column index+   -> Lens' (Row k a) (Maybe a) at k f m = f mv <&> \case     Nothing -> maybe m (const (delete k m)) mv     Just v' -> insert k v' m@@ -144,7 +154,7 @@ e.g.  @->>> :t \k -> 'Lens.Micro.toListOf' (eachPrefixed k . 'vpBool')+>>> :t \k -> 'Lens.Micro.toListOf' (eachPrefixed k . vpBool) (GT.TrieKey k, Eq k) => [k] -> Row [k] VP -> [Bool] @ -}@@ -179,6 +189,51 @@  -- keep :: (Eq a) => Getting Any row a -> a -> row -> Bool -- keep l v = has (l . to (== v))+++-- ** Getters++-- | Lookup a real number at the given index.+--+-- Matches `Double`, `Float`, `Int` and `Scientific` values.+real :: GT.TrieKey k => k -> Row k VP -> Maybe Double+real k r = g1 <|> g2 <|> g3 <|> g4+  where+    g1 = r ^? int k . to fromIntegral+    g2 = r ^? double k+    g3 = r ^? float k . to (fromRational . toRational)+    g4 = r ^? scientific k . to (fromRational . toRational)++-- | Look up a text string at the given index.+--+-- Matches `String` and `Text` values.+txt :: GT.TrieKey k => k -> Row k VP -> Maybe Text+txt k r = g1 <|> g2+  where+    g1 = r ^? string k . to T.pack+    g2 = r ^? text k++-- -- | Lookup a "flag" at the given index.+-- --+-- -- `Bool`ean values and +-- flag :: GT.TrieKey k => k -> Row k VP -> Maybe Bool+-- flag k r = g1 <|> g2+--   where+--     g1 = r ^? bool k+--     g2 = r ^? char k . to f+--     f c = elem c ['y', 'Y']++-- class Contains a where+--   contains_ :: GT.TrieKey k => k -> Traversal' (Row k VP) a++-- instance Contains Int where contains_ = int+-- instance Contains Char where contains_ = char++-- contains :: (Contains a, Eq a, GT.TrieKey k, Monoid r, Foldable t) =>+--             k+--          -> t a+--          -> Getting r (Row k VP) Bool+-- contains k xs = contains_ k . to (`elem` xs)  -- ** Lenses
stack.yaml view
@@ -5,12 +5,13 @@ # resolver: lts-13.17  # GHC 8.6.4 # resolver: lts-13.21  # GHC 8.6.5 resolver: lts-14.19 # 8.6.5+# resolver: lts-16.18 # GHC 8.8.4  packages: - . -extra-deps: -- generic-trie-0.3.1@sha256:203cfc0086372abaf99ffb4b4b565eba8a28e6020f1104ec479cd96d0c3baeb7+extra-deps:+- generic-trie-0.3.1@sha256:203cfc0086372abaf99ffb4b4b565eba8a28e6020f1104ec479cd96d0c3baeb7,1604  # Override default flag values for local packages and extra-deps # flags: {}
− test/DocTest.hs 
@@ -1,12 +0,0 @@-module Main where--import Test.DocTest (doctest)--main :: IO ()-main = doctest [-  -- "src/Data/Generics/Encode/OneHot.hs",-  -- "src/Heidi.hs"-  -- "src/Data/Generics/Encode/Internal.hs",  -  -- "src/Core/Data/Frame/Generic.hs",-  "src/Core/Data/Frame/List.hs"  -  ]
test/Main.hs view
@@ -10,12 +10,12 @@     test_gtr <- testSpec "GenericTrie-based rows" spec_Frame_GTR     defaultMain $ do       testGroup "Heidi.Data.Frame.Algorithms" [test_gtr]-  + spec_Frame_GTR :: Spec-spec_Frame_GTR = parallel $ do  +spec_Frame_GTR = parallel $ do   UGTR.test_innerJoin   UGTR.test_leftOuterJoin-  UGTR.test_groupBy  +  UGTR.test_groupBy  -- spec :: Spec -- spec = parallel $ do