-----------------------------------------------------------------------------
-- |
-- Module      :  Heidi.Data.Frame.Algorithms.GenericTrie
-- Description :  GenericTrie-based dataframe algorithms
-- Copyright   :  (c) Marco Zocca (2018-2019)
-- License     :  BSD-style
-- Maintainer  :  ocramz fripost org
-- Stability   :  experimental
-- Portability :  GHC
--
-----------------------------------------------------------------------------
module Heidi.Data.Frame.Algorithms.GenericTrie (
  -- ** Row-wise operations
  unionColsWith  
  -- ** Filtering 
  -- , filterByKey
  -- ** Data tidying
  , spreadWith, gatherWith
  -- ** Relational operations
  , groupBy, innerJoin, leftOuterJoin
                                           ) where

import Data.Maybe (fromMaybe)
-- import Control.Applicative (Alternative(..))
import qualified Data.Foldable as F (foldMap, foldl', foldlM)
-- import Data.Foldable (foldl, foldr, foldlM, foldrM)
-- import Data.Typeable (Typeable)

-- containers
import qualified Data.Map as M
import qualified Data.Set as S (Set, fromList)
-- exception
-- import Control.Monad.Catch(Exception(..), MonadThrow(..))

-- primitive
-- import Control.Monad.Primitive (PrimMonad(..), PrimState(..))
-- scientific
-- import Data.Scientific (Scientific, toRealFloat)
-- vector
-- import qualified Data.Vector as V
-- import qualified Data.Vector.Generic.Mutable as VGM
-- vector-algorithms
-- import qualified Data.Vector.Algorithms.Merge as V (sort, sortBy, Comparison)
-- generic-trie
import qualified Data.GenericTrie as GT
-- text
-- import qualified Data.Text as T (pack)
-- import Data.Text (Text)


-- import qualified Data.Generics.Decode as D (Decode, runDecode)
-- import Data.Generics.Decode ((>>>))
import Core.Data.Frame.List (Frame, frameFromList, zipWith)
import qualified Heidi.Data.Row.GenericTrie as GTR
-- import Core.Data.Row.Internal
-- import Data.Generics.Encode.Val (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)



-- -- insertDecode :: (Functor f, GT.TrieKey k) =>
-- --                 D.Decode f (GTR.Row k v) v  -- !!! this constrains start, end value types to be identical
-- --              -> k
-- --              -> GTR.Row k v
-- --              -> f (GTR.Row k v)
-- insertDecode dec g k row = f <$> D.runDecode dec row where
--   f x = GTR.insert k (g x) row

-- -- sumCols k1 k2 = insertDecode fk where
-- --   fk = (+) <$> GTR.scientific k1 <*> GTR.scientific k2
  


-- | Merge two frames by taking the set union of the columns
unionColsWith :: (Eq k, GT.TrieKey k) =>
                 (v -> v -> v)   -- ^ Element combination function
              -> Frame (GTR.Row k v)
              -> Frame (GTR.Row k v)
              -> Frame (GTR.Row k v)
unionColsWith :: (v -> v -> v)
-> Frame (Row k v) -> Frame (Row k v) -> Frame (Row k v)
unionColsWith v -> v -> v
f = (Row k v -> Row k v -> Row k v)
-> Frame (Row k v) -> Frame (Row k v) -> Frame (Row k v)
forall a b c. (a -> b -> c) -> Frame a -> Frame b -> Frame c
zipWith ((v -> v -> v) -> Row k v -> Row k v -> Row k v
forall k v.
TrieKey k =>
(v -> v -> v) -> Row k v -> Row k v -> Row k v
GTR.unionWith v -> v -> v
f)


-- | Filter a 'Frame' according to predicate applied to an element pointed to by a given key.
--
-- >>> numRows <$> filterByKey "item" (/= "book") t0
-- Just 2
-- filterByKey :: (Eq k, GT.TrieKey k) =>
--                k            -- ^ Key
--             -> (v -> Bool)  -- ^ Predicate to be applied to the element
--             -> Frame (GTR.Row k v)
--             -> Frame (GTR.Row k v)
-- filterByKey k ff = filter (k GTR.!: ff)



-- * Data tidying

-- | 'gatherWith' moves column names into a "key" column, gathering the column values into a single "value" column
gatherWith :: (Foldable t, Ord k, GT.TrieKey k) =>
              (k -> v)
           -> S.Set k     -- ^ set of keys to gather
           -> k           -- ^ "key" key
           -> k           -- ^ "value" key
           -> t (GTR.Row k v) -- ^ input dataframe
           -> Frame (GTR.Row k v)
gatherWith :: (k -> v) -> Set k -> k -> k -> t (Row k v) -> Frame (Row k v)
gatherWith k -> v
fk Set k
ks k
kKey k
kValue = [Row k v] -> Frame (Row k v)
forall row. [row] -> Frame row
frameFromList ([Row k v] -> Frame (Row k v))
-> (t (Row k v) -> [Row k v]) -> t (Row k v) -> Frame (Row k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row k v -> [Row k v]) -> t (Row k v) -> [Row k v]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Row k v -> [Row k v]
f where
  f :: Row k v -> [Row k v]
f Row k v
row = (k -> v) -> Set k -> Row k v -> k -> k -> [Row k v]
forall k v.
(Ord k, TrieKey k) =>
(k -> v) -> Set k -> Row k v -> k -> k -> [Row k v]
gather1 k -> v
fk Set k
ks Row k v
row k
kKey k
kValue

-- | gather one row into a list of rows
gather1 :: (Ord k, GT.TrieKey k) =>
           (k -> v)
        -> S.Set k
        -> GTR.Row k v -- ^ row to look into
        -> k           -- ^ "key" key
        -> k           -- ^ "value" key
        -> [GTR.Row k v]
gather1 :: (k -> v) -> Set k -> Row k v -> k -> k -> [Row k v]
gather1 k -> v
fk Set k
ks Row k v
row k
kKey k
kValue = [Row k v] -> Maybe [Row k v] -> [Row k v]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Row k v] -> [Row k v]) -> Maybe [Row k v] -> [Row k v]
forall a b. (a -> b) -> a -> b
$ ([Row k v] -> k -> Maybe [Row k v])
-> [Row k v] -> Set k -> Maybe [Row k v]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM [Row k v] -> k -> Maybe [Row k v]
insf [] Set k
ks where
  rowBase :: Row k v
rowBase = Set k -> Row k v -> Row k v
forall k (t :: * -> *) v.
(TrieKey k, Foldable t) =>
t k -> Row k v -> Row k v
GTR.deleteMany Set k
ks Row k v
row
  lookupInsert :: k -> Maybe (Row k v)
lookupInsert k
k = do
    v
x <- k -> Row k v -> Maybe v
forall k v. TrieKey k => k -> Row k v -> Maybe v
GTR.lookup k
k Row k v
row
    let
      r' :: Row k v
r'  = k -> v -> Row k v -> Row k v
forall k v. TrieKey k => k -> v -> Row k v -> Row k v
GTR.insert k
kKey   (k -> v
fk k
k) Row k v
rowBase
      r'' :: Row k v
r'' = k -> v -> Row k v -> Row k v
forall k v. TrieKey k => k -> v -> Row k v -> Row k v
GTR.insert k
kValue v
x Row k v
r'
    Row k v -> Maybe (Row k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row k v
r''
  insf :: [Row k v] -> k -> Maybe [Row k v]
insf [Row k v]
acc k
k = do
    Row k v
r' <- k -> Maybe (Row k v)
lookupInsert k
k
    [Row k v] -> Maybe [Row k v]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Row k v] -> Maybe [Row k v]) -> [Row k v] -> Maybe [Row k v]
forall a b. (a -> b) -> a -> b
$ Row k v
r' Row k v -> [Row k v] -> [Row k v]
forall a. a -> [a] -> [a]
: [Row k v]
acc
{-# inline gather1 #-}




-- | 'spreadWith' moves the unique values of a key column into the column names, spreading the values of a value column across the new columns.
spreadWith :: (GT.TrieKey k, Foldable t, Ord k, Ord v) =>
              (v -> k)
           -> k   -- ^ "key" key
           -> k   -- ^ "value" key
           -> t (GTR.Row k v)  -- ^ input dataframe
           -> Frame (GTR.Row k v)
spreadWith :: (v -> k) -> k -> k -> t (Row k v) -> Frame (Row k v)
spreadWith v -> k
fk k
k1 k
k2 = [Row k v] -> Frame (Row k v)
forall row. [row] -> Frame row
frameFromList ([Row k v] -> Frame (Row k v))
-> (t (Row k v) -> [Row k v]) -> t (Row k v) -> Frame (Row k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Row k v, Row k v) -> Row k v)
-> [(Row k v, Row k v)] -> [Row k v]
forall a b. (a -> b) -> [a] -> [b]
map (Row k v, Row k v) -> Row k v
forall k v. TrieKey k => (Row k v, Row k v) -> Row k v
funion ([(Row k v, Row k v)] -> [Row k v])
-> (t (Row k v) -> [(Row k v, Row k v)])
-> t (Row k v)
-> [Row k v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Row k v) (Row k v) -> [(Row k v, Row k v)]
forall k a. Map k a -> [(k, a)]
M.toList (Map (Row k v) (Row k v) -> [(Row k v, Row k v)])
-> (t (Row k v) -> Map (Row k v) (Row k v))
-> t (Row k v)
-> [(Row k v, Row k v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Row k v) (Row k v) -> Row k v -> Map (Row k v) (Row k v))
-> Map (Row k v) (Row k v)
-> t (Row k v)
-> Map (Row k v) (Row k v)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((v -> k)
-> k
-> k
-> Map (Row k v) (Row k v)
-> Row k v
-> Map (Row k v) (Row k v)
forall k v.
(Ord k, Ord v, TrieKey k, Eq k) =>
(v -> k)
-> k
-> k
-> Map (Row k v) (Row k v)
-> Row k v
-> Map (Row k v) (Row k v)
spread1 v -> k
fk k
k1 k
k2) Map (Row k v) (Row k v)
forall k a. Map k a
M.empty
  where
    funion :: (Row k v, Row k v) -> Row k v
funion (Row k v
km, Row k v
vm) = Row k v -> Row k v -> Row k v
forall k v. TrieKey k => Row k v -> Row k v -> Row k v
GTR.union Row k v
km Row k v
vm
  
-- | spread1 creates a single row from multiple ones that share a subset of key-value pairs.
spread1 :: (Ord k, Ord v, GT.TrieKey k, Eq k) =>
           (v -> k)
        -> k
        -> k
        -> M.Map (GTR.Row k v) (GTR.Row k v)
        -> GTR.Row k v
        -> M.Map (GTR.Row k v) (GTR.Row k v)
spread1 :: (v -> k)
-> k
-> k
-> Map (Row k v) (Row k v)
-> Row k v
-> Map (Row k v) (Row k v)
spread1 v -> k
fk k
k1 k
k2 Map (Row k v) (Row k v)
hmacc Row k v
row = Row k v
-> Row k v -> Map (Row k v) (Row k v) -> Map (Row k v) (Row k v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Row k v
rowBase Row k v
kvNew Map (Row k v) (Row k v)
hmacc where
  ks :: Set k
ks = [k] -> Set k
forall a. Ord a => [a] -> Set a
S.fromList [k
k1, k
k2]
  rowBase :: Row k v
rowBase = Set k -> Row k v -> Row k v
forall k (t :: * -> *) v.
(TrieKey k, Foldable t) =>
t k -> Row k v -> Row k v
GTR.deleteMany Set k
ks Row k v
row
  hmv :: Row k v
hmv = Maybe (Row k v) -> Row k v
forall k v. TrieKey k => Maybe (Row k v) -> Row k v
GTR.maybeEmpty (Maybe (Row k v) -> Row k v) -> Maybe (Row k v) -> Row k v
forall a b. (a -> b) -> a -> b
$ Row k v -> Map (Row k v) (Row k v) -> Maybe (Row k v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Row k v
rowBase Map (Row k v) (Row k v)
hmacc
  kvNew :: Row k v
kvNew = Maybe (Row k v) -> Row k v
forall k v. TrieKey k => Maybe (Row k v) -> Row k v
GTR.maybeEmpty (Maybe (Row k v) -> Row k v) -> Maybe (Row k v) -> Row k v
forall a b. (a -> b) -> a -> b
$ do
    v
k <- k -> Row k v -> Maybe v
forall k v. TrieKey k => k -> Row k v -> Maybe v
GTR.lookup k
k1 Row k v
row
    v
v <- k -> Row k v -> Maybe v
forall k v. TrieKey k => k -> Row k v -> Maybe v
GTR.lookup k
k2 Row k v
row
    Row k v -> Maybe (Row k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Row k v -> Maybe (Row k v)) -> Row k v -> Maybe (Row k v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Row k v -> Row k v
forall k v. TrieKey k => k -> v -> Row k v -> Row k v
GTR.insert (v -> k
fk v
k) v
v Row k v
hmv
{-# inline spread1 #-}    




-- r0, r1, r2, r3 :: GTR.Row String String
-- r0 = GTR.fromKVs [
--     ("country", "A"), ("type", "cases"), ("count", "0.7")]
-- r1 = GTR.fromKVs [
--     ("country", "A"), ("type", "pop"), ("count", "19")]
-- r2 = GTR.fromKVs [
--     ("country", "B"), ("type", "cases"), ("count", "37")] 
-- r3 = GTR.fromKVs [
--     ("country", "B"), ("type", "pop"), ("count", "172")]    

-- -- frame0 :: [GTR.Row String String]
-- frame0 = fromList [r0, r1, r2, r3] 

-- fr1 = spread id "type" "count" frame0

-- fr2 = gather id (S.fromList ["cases", "pop"]) "type" "count" fr1





-- * Relational operations

-- | GROUP BY : given a key and a table that uses it, split the table in multiple tables, one per value taken by the key.
--
-- >>> numRows <$> (HM.lookup "129" $ groupBy "id.0" t0)
-- Just 2
groupBy :: (Foldable t, GT.TrieKey k, Eq k, Ord v) =>
           k  -- ^ Key to group by
        -> t (GTR.Row k v) -- ^ A 'Frame (GTR.Row k v) can be used here
        -> M.Map v (Frame (GTR.Row k v))
groupBy :: k -> t (Row k v) -> Map v (Frame (Row k v))
groupBy k
k t (Row k v)
tbl = [Row k v] -> Frame (Row k v)
forall row. [row] -> Frame row
frameFromList ([Row k v] -> Frame (Row k v))
-> Map v [Row k v] -> Map v (Frame (Row k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> t (Row k v) -> Map v [Row k v]
forall (t :: * -> *) k v.
(Foldable t, Eq k, TrieKey k, Eq v, Ord v) =>
k -> t (Row k v) -> Map v [Row k v]
groupL k
k t (Row k v)
tbl

groupL :: (Foldable t, Eq k, GT.TrieKey k, Eq v, Ord v) =>
          k -> t (GTR.Row k v) -> M.Map v [GTR.Row k v]
groupL :: k -> t (Row k v) -> Map v [Row k v]
groupL k
k t (Row k v)
tbl = (Map v [Row k v] -> Row k v -> Map v [Row k v])
-> Map v [Row k v] -> t (Row k v) -> Map v [Row k v]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Map v [Row k v] -> Row k v -> Map v [Row k v]
forall k. Ord k => Map k [Row k k] -> Row k k -> Map k [Row k k]
insf Map v [Row k v]
forall k a. Map k a
M.empty t (Row k v)
tbl where
  insf :: Map k [Row k k] -> Row k k -> Map k [Row k k]
insf Map k [Row k k]
acc Row k k
row = Map k [Row k k]
-> (k -> Map k [Row k k]) -> Maybe k -> Map k [Row k k]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map k [Row k k]
acc (\k
v -> ([Row k k] -> [Row k k] -> [Row k k])
-> k -> [Row k k] -> Map k [Row k k] -> Map k [Row k k]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Row k k] -> [Row k k] -> [Row k k]
forall a. [a] -> [a] -> [a]
(++) k
v [Row k k
row] Map k [Row k k]
acc) (k -> Row k k -> Maybe k
forall k v. TrieKey k => k -> Row k v -> Maybe v
GTR.lookup k
k Row k k
row)
{-# inline groupL #-}





joinWith :: (Foldable t, Ord v, GT.TrieKey k, Eq v, Eq k) =>
            (GTR.Row k v -> [GTR.Row k v] -> [GTR.Row k v])
         -> k
         -> k
         -> t (GTR.Row k v)
         -> t (GTR.Row k v)
         -> Frame (GTR.Row k v)
joinWith :: (Row k v -> [Row k v] -> [Row k v])
-> k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
joinWith Row k v -> [Row k v] -> [Row k v]
f k
k1 k
k2 t (Row k v)
table1 t (Row k v)
table2 = [Row k v] -> Frame (Row k v)
forall row. [row] -> Frame row
frameFromList ([Row k v] -> Frame (Row k v)) -> [Row k v] -> Frame (Row k v)
forall a b. (a -> b) -> a -> b
$ ([Row k v] -> Row k v -> [Row k v])
-> [Row k v] -> t (Row k v) -> [Row k v]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' [Row k v] -> Row k v -> [Row k v]
insf [] t (Row k v)
table1 where
  insf :: [Row k v] -> Row k v -> [Row k v]
insf [Row k v]
acc Row k v
row1 = [Row k v] -> (v -> [Row k v]) -> Maybe v -> [Row k v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Row k v -> [Row k v] -> [Row k v]
f Row k v
row1 [Row k v]
acc) v -> [Row k v]
appendMatchRows (k -> Row k v -> Maybe v
forall k v. TrieKey k => k -> Row k v -> Maybe v
GTR.lookup k
k1 Row k v
row1) where
    appendMatchRows :: v -> [Row k v]
appendMatchRows v
v = (Row k v -> Row k v) -> [Row k v] -> [Row k v]
forall a b. (a -> b) -> [a] -> [b]
map (Row k v -> Row k v -> Row k v
forall k v. TrieKey k => Row k v -> Row k v -> Row k v
GTR.union Row k v
row1) [Row k v]
mr2 [Row k v] -> [Row k v] -> [Row k v]
forall a. [a] -> [a] -> [a]
++ [Row k v]
acc where
      mr2 :: [Row k v]
mr2 = k -> v -> t (Row k v) -> [Row k v]
forall (t :: * -> *) k v.
(Foldable t, TrieKey k, Eq k, Ord v) =>
k -> v -> t (Row k v) -> [Row k v]
matchingRows k
k2 v
v t (Row k v)
table2



-- | LEFT (OUTER) JOIN : given two dataframes and one key from each, compute the left outer join using the keys as relations.
leftOuterJoin :: (Foldable t, Ord v, GT.TrieKey k, Eq v, Eq k) =>
                 k
              -> k
              -> t (GTR.Row k v)
              -> t (GTR.Row k v)
              -> Frame (GTR.Row k v)
leftOuterJoin :: k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
leftOuterJoin = (Row k v -> [Row k v] -> [Row k v])
-> k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
forall (t :: * -> *) v k.
(Foldable t, Ord v, TrieKey k, Eq v, Eq k) =>
(Row k v -> [Row k v] -> [Row k v])
-> k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
joinWith (:)


-- | INNER JOIN : given two dataframes and one key from each, compute the inner join using the keys as relations.
--
-- >>> head t0
-- [("id.0","129"),("qty","1"),("item","book")]
--
-- >>> head t1
-- [("id.1","129"),("price","100")]
-- 
-- >>> head $ innerJoin "id.0" "id.1" t0 t1
-- [("id.1","129"),("id.0","129"),("qty","5"),("item","book"),("price","100")]
innerJoin :: (Foldable t, Ord v, GT.TrieKey k, Eq v, Eq k) =>
             k  -- ^ Key into the first table
          -> k  -- ^ Key into the second table
          -> t (GTR.Row k v)  -- ^ First dataframe
          -> t (GTR.Row k v)  -- ^ Second dataframe
          -> Frame (GTR.Row k v)
innerJoin :: k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
innerJoin = (Row k v -> [Row k v] -> [Row k v])
-> k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
forall (t :: * -> *) v k.
(Foldable t, Ord v, TrieKey k, Eq v, Eq k) =>
(Row k v -> [Row k v] -> [Row k v])
-> k -> k -> t (Row k v) -> t (Row k v) -> Frame (Row k v)
joinWith Row k v -> [Row k v] -> [Row k v]
seq



  


matchingRows :: (Foldable t, GT.TrieKey k, Eq k, Ord v) =>
                k -> v -> t (GTR.Row k v) -> [GTR.Row k v]
matchingRows :: k -> v -> t (Row k v) -> [Row k v]
matchingRows k
k v
v t (Row k v)
rows = [Row k v] -> Maybe [Row k v] -> [Row k v]
forall a. a -> Maybe a -> a
fromMaybe [] (v -> Map v [Row k v] -> Maybe [Row k v]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
v Map v [Row k v]
rowMap) where
  rowMap :: Map v [Row k v]
rowMap = k -> t (Row k v) -> Map v [Row k v]
forall (t :: * -> *) k v.
(Foldable t, Eq k, TrieKey k, Eq v, Ord v) =>
k -> t (Row k v) -> Map v [Row k v]
hjBuild k
k t (Row k v)
rows
{-# INLINE matchingRows #-}
    
-- | "build" phase of the hash-join algorithm
--
-- For a given key 'k' and a set of frame rows, populates a hashmap from the _values_ corresponding to 'k' to the corresponding rows.
hjBuild :: (Foldable t, Eq k, GT.TrieKey k, Eq v, Ord v) =>
           k -> t (GTR.Row k v) -> M.Map v [GTR.Row k v]
hjBuild :: k -> t (Row k v) -> Map v [Row k v]
hjBuild k
k = (Map v [Row k v] -> Row k v -> Map v [Row k v])
-> Map v [Row k v] -> t (Row k v) -> Map v [Row k v]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Map v [Row k v] -> Row k v -> Map v [Row k v]
forall k. Ord k => Map k [Row k k] -> Row k k -> Map k [Row k k]
insf Map v [Row k v]
forall k a. Map k a
M.empty where
  insf :: Map k [Row k k] -> Row k k -> Map k [Row k k]
insf Map k [Row k k]
hmAcc Row k k
row = Map k [Row k k]
-> (k -> Map k [Row k k]) -> Maybe k -> Map k [Row k k]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map k [Row k k]
hmAcc (\k
v -> ([Row k k] -> [Row k k] -> [Row k k])
-> k -> [Row k k] -> Map k [Row k k] -> Map k [Row k k]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Row k k] -> [Row k k] -> [Row k k]
forall a. [a] -> [a] -> [a]
(++) k
v [Row k k
row] Map k [Row k k]
hmAcc) (Maybe k -> Map k [Row k k]) -> Maybe k -> Map k [Row k k]
forall a b. (a -> b) -> a -> b
$ k -> Row k k -> Maybe k
forall k v. TrieKey k => k -> Row k v -> Maybe v
GTR.lookup k
k Row k k
row
{-# INLINE hjBuild #-}