{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  $header
-- Copyright   :  (c) Laurent P. René de Cotret
-- License     :  MIT
-- Maintainer  :  laurent.decotret@outlook.com
-- Portability :  portable
-- Stability   :  experimental
--
-- This is an experimental interface to dataframes.
--
-- This module defines the type machinery and some functions to
-- process data frames. Data frames are structures where every
-- row corresponds to an object, but data is stored in
-- contiguous arrays known as columns.
--
-- A user guide is provided in the "Data.Frame.Tutorial" module.

module Data.Frame (
    -- * Defining dataframe types
    Column, Frameable, Row, Frame,

    -- * Construction and deconstruction
    fromRows, toRows, fields,

    -- * Operations on rows
    null, length, mapRows, mapRowsM, filterRows, foldlRows,
    -- ** Sorting rows in frames
    sortRowsBy, sortRowsByUnique, 
    sortRowsByKey, sortRowsByKeyUnique, sortRowsByKeyUniqueOn,

    -- * Displaying frames
    display,
    -- ** Customizing the display of frames
    displayWith, DisplayOptions(..), defaultDisplayOptions, 

    -- * Indexing operations
    -- ** Based on integer indices
    ilookup, iat,
    -- ** Based on indexable frames
    Indexable(Key, index), lookup, at,

    -- * Merging dataframes
    -- ** Zipping rows in order
    zipRowsWith,
    -- ** Merging using an index
    mergeWithStrategy, mergeWithStrategyOn, matchedStrategy,
    -- *** Helpers to define your own merge strategies
    These(..),
) where


import Control.Exception (assert)
import Control.Monad.ST ( runST )
import Data.Bifunctor (second)
import qualified Data.Foldable
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Functor.Identity (Identity(..))
import Data.Kind (Type)
import qualified Data.List as List ( intersperse, foldl' )
import Data.Maybe (catMaybes)
import Data.Sequence (Seq(..))
import qualified Data.Sequence as Seq
import Data.Semigroup (Max(..))
import qualified Data.Set as Set
import Data.These (These(..))
import Data.Tuple (swap)
import Data.Vector (Vector)
import qualified Data.Vector
import qualified Data.Vector.Algorithms.Tim as TimSort (sortBy, sortUniqBy)
import Prelude hiding (lookup, null, length)
import qualified Prelude
import GHC.Generics ( Selector, Generic(..), S, D, C, K1(..), Rec0, M1(..), type (:*:)(..), selName )


-- $setup
-- >>> import qualified Data.Vector as Vector

-- | Build a dataframe from a container of rows.
--
-- For the inverse operation, see `toRows`.
fromRows :: (Frameable t, Foldable f)
         => f (Row t)
         -> Frame t
fromRows :: forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows = Vector (Row t) -> Frame t
forall (t :: (* -> *) -> *).
Frameable t =>
Vector (Row t) -> Frame t
pack (Vector (Row t) -> Frame t)
-> (f (Row t) -> Vector (Row t)) -> f (Row t) -> Frame t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Row t] -> Vector (Row t)
forall a. [a] -> Vector a
Data.Vector.fromList ([Row t] -> Vector (Row t))
-> (f (Row t) -> [Row t]) -> f (Row t) -> Vector (Row t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Row t) -> [Row t]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
{-# INLINE[~2] fromRows #-}


-- | Deconstruct a dataframe into its rows.
--
-- For the inverse operation, see `fromRows`.
toRows :: Frameable t 
       => Frame t
       -> Vector (Row t)
toRows :: forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows = Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
unpack
{-# INLINE[~2] toRows #-}


-- TODO: Chaining operations such as `mapRows` and `filterRows`
--       should benefit from optimizing as `toRows . fromRows = id`
--       ( and `fromRows . toRows = id` as well).
--       See the rules below.
--       It's not clear if I'm using the rewrite system correctly,
--       by looking at the benchmark resuylts
{-# RULES
"fromRows/toRows" [2] fromRows . toRows = id
"toRows/fromRows" [2] toRows . fromRows = id 
  #-}

-- | Returns `True` if a dataframe has no rows.
null :: Frameable t
     => Frame t
     -> Bool
-- TODO: we can use yet another typeclass deriving
-- from generic to only look at ONE of the columns,
-- rather than reconstructing the first row
null :: forall (t :: (* -> *) -> *). Frameable t => Frame t -> Bool
null = Vector (Row t) -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector (Row t) -> Bool)
-> (Frame t -> Vector (Row t)) -> Frame t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows


-- | Access the length of a dataframe, i.e. the number of rows.
length :: Frameable t
       => Frame t
       -> Int
-- TODO: we can use yet another typeclass deriving
-- from generic to only look at ONE of the columns,
-- rather than reconstructing all rows.
length :: forall (t :: (* -> *) -> *). Frameable t => Frame t -> Int
length = Vector (Row t) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Row t) -> Int)
-> (Frame t -> Vector (Row t)) -> Frame t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows


-- | Map a function over each row individually.
--
-- For mapping with a monadic action, see `mapRowsM`.
mapRows :: (Frameable t1, Frameable t2)
        => (Row t1 -> Row t2)
        -> Frame t1
        -> Frame t2
mapRows :: forall (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *).
(Frameable t1, Frameable t2) =>
(Row t1 -> Row t2) -> Frame t1 -> Frame t2
mapRows Row t1 -> Row t2
f = Vector (Row t2) -> Frame t2
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows 
           (Vector (Row t2) -> Frame t2)
-> (Frame t1 -> Vector (Row t2)) -> Frame t1 -> Frame t2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row t1 -> Row t2) -> Vector (Row t1) -> Vector (Row t2)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Row t1 -> Row t2
f 
           (Vector (Row t1) -> Vector (Row t2))
-> (Frame t1 -> Vector (Row t1)) -> Frame t1 -> Vector (Row t2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t1 -> Vector (Row t1)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows


-- | Map each element of a dataframe to a monadic action, evaluate
-- these actions from left to right, and collect the result
-- in a new dataframe.
--
-- For mapping without a monadic action, see `mapRows`.
mapRowsM :: (Frameable t1, Frameable t2, Monad m)
         => (Row t1 -> m (Row t2))
         -> Frame t1
         -> m (Frame t2)
mapRowsM :: forall (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *) (m :: * -> *).
(Frameable t1, Frameable t2, Monad m) =>
(Row t1 -> m (Row t2)) -> Frame t1 -> m (Frame t2)
mapRowsM Row t1 -> m (Row t2)
f = (Vector (Row t2) -> Frame t2)
-> m (Vector (Row t2)) -> m (Frame t2)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (Row t2) -> Frame t2
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows
            (m (Vector (Row t2)) -> m (Frame t2))
-> (Frame t1 -> m (Vector (Row t2))) -> Frame t1 -> m (Frame t2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row t1 -> m (Row t2)) -> Vector (Row t1) -> m (Vector (Row t2))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
Data.Vector.mapM Row t1 -> m (Row t2)
f
            (Vector (Row t1) -> m (Vector (Row t2)))
-> (Frame t1 -> Vector (Row t1)) -> Frame t1 -> m (Vector (Row t2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t1 -> Vector (Row t1)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows


-- | Filter rows from a @`Frame` t@, only keeping
-- the rows where the predicate is `True`.
filterRows :: (Frameable t)
           => (Row t -> Bool)
           -> Frame t
           -> Frame t
filterRows :: forall (t :: (* -> *) -> *).
Frameable t =>
(Row t -> Bool) -> Frame t -> Frame t
filterRows Row t -> Bool
f = Vector (Row t) -> Frame t
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows 
              (Vector (Row t) -> Frame t)
-> (Frame t -> Vector (Row t)) -> Frame t -> Frame t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row t -> Bool) -> Vector (Row t) -> Vector (Row t)
forall a. (a -> Bool) -> Vector a -> Vector a
Data.Vector.filter Row t -> Bool
f
              (Vector (Row t) -> Vector (Row t))
-> (Frame t -> Vector (Row t)) -> Frame t -> Vector (Row t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows


-- | Zip two frames together using a combination function.
-- Rows from each frame are matched in order; the resulting
-- frame will only contain as many rows as the shortest of
-- the two input frames
zipRowsWith :: (Frameable t1, Frameable t2, Frameable t3)
              => (Row t1 -> Row t2 -> Row t3)
              -> Frame t1
              -> Frame t2
              -> Frame t3
zipRowsWith :: forall (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *)
       (t3 :: (* -> *) -> *).
(Frameable t1, Frameable t2, Frameable t3) =>
(Row t1 -> Row t2 -> Row t3) -> Frame t1 -> Frame t2 -> Frame t3
zipRowsWith Row t1 -> Row t2 -> Row t3
f Frame t1
xs Frame t2
ys 
    = Vector (Row t3) -> Frame t3
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows 
    (Vector (Row t3) -> Frame t3) -> Vector (Row t3) -> Frame t3
forall a b. (a -> b) -> a -> b
$ (Row t1 -> Row t2 -> Row t3)
-> Vector (Row t1) -> Vector (Row t2) -> Vector (Row t3)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Data.Vector.zipWith Row t1 -> Row t2 -> Row t3
f 
                          (Frame t1 -> Vector (Row t1)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t1
xs)
                          (Frame t2 -> Vector (Row t2)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t2
ys)


-- | Left-associative fold of a structure, with strict application of the operator.
foldlRows :: Frameable t
          => (b -> Row t -> b) -- ^ Reduction function that takes in individual rows
          -> b                 -- ^ Initial value for the accumulator
          -> Frame t           -- ^ Data frame
          -> b
foldlRows :: forall (t :: (* -> *) -> *) b.
Frameable t =>
(b -> Row t -> b) -> b -> Frame t -> b
foldlRows b -> Row t -> b
f b
start 
    = (b -> Row t -> b) -> b -> Vector (Row t) -> b
forall a b. (a -> b -> a) -> a -> Vector b -> a
Data.Vector.foldl' b -> Row t -> b
f b
start (Vector (Row t) -> b)
-> (Frame t -> Vector (Row t)) -> Frame t -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows


-- | Access a row from a dataframe by its integer index. Indexing
-- starts at 0, representing the first row.
--
-- If the index is larger than the number of rows, this function
-- returns `Nothing`.
--
-- To access a specific row AND column, `iat` is much more efficient.
--
-- To lookup a row based on a non-integer index, see `lookup`.
ilookup :: Frameable t
        => Int
        -> Frame t
        -> Maybe (Row t)
ilookup :: forall (t :: (* -> *) -> *).
Frameable t =>
Int -> Frame t -> Maybe (Row t)
ilookup = Int -> Frame t -> Maybe (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Int -> Frame t -> Maybe (Row t)
iindex


-- | Sort the rows of a frame using a custom comparison function.
--
-- Use the function `on` from "Data.Function" to easily create 
-- comparison functions. See the example below. 
--
-- If you wish to prune rows with duplicates, see `sortRowsByUnique`. 
-- If your dataframe has an instance of `Indexable`, see `sortRowsByKey`.
--
-- For example, let's say we want to sort
-- a dataframe of students by their first name:
-- 
-- >>> :{
--      data Student f
--          = MkStudent { studentName      :: Column f String
--                      , studentAge       :: Column f Int
--                      , studentMathGrade :: Column f Char
--                      }
--          deriving (Generic, Frameable)
--      students = fromRows 
--               [ MkStudent "Erika" 13 'D'
--               , MkStudent "Beatrice" 13 'B'
--               , MkStudent "David" 13 'A'
--               , MkStudent "Albert" 12 'C'
--               , MkStudent "Frank" 11 'C'
--               , MkStudent "Clara" 12 'A'
--               ]
-- :}
--
-- >>> import Data.Function (on)
-- >>> putStrLn $ display $ sortRowsBy (compare `on` studentName) students
-- studentName | studentAge | studentMathGrade
-- ----------- | ---------- | ----------------
--    "Albert" |         12 |              'C' 
--  "Beatrice" |         13 |              'B'
--     "Clara" |         12 |              'A'
--     "David" |         13 |              'A'
--     "Erika" |         13 |              'D'
--     "Frank" |         11 |              'C'
--
-- The underlying sorting algorithm is timsort (via 
-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number 
-- of comparisons used.
sortRowsBy :: Frameable t
           => (Row t -> Row t -> Ordering)
           -> Frame t
           -> Frame t
sortRowsBy :: forall (t :: (* -> *) -> *).
Frameable t =>
(Row t -> Row t -> Ordering) -> Frame t -> Frame t
sortRowsBy Row t -> Row t -> Ordering
cmp Frame t
df
    = let rs :: Vector (Row t)
rs = Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t
df 
       in Vector (Row t) -> Frame t
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows (Vector (Row t) -> Frame t) -> Vector (Row t) -> Frame t
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Vector (Row t))) -> Vector (Row t)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (Row t))) -> Vector (Row t))
-> (forall s. ST s (Vector (Row t))) -> Vector (Row t)
forall a b. (a -> b) -> a -> b
$ do
        MVector s (Row t)
mutVec <- Vector (Row t) -> ST s (MVector (PrimState (ST s)) (Row t))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Data.Vector.thaw Vector (Row t)
rs
        (Row t -> Row t -> Ordering)
-> MVector (PrimState (ST s)) (Row t) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
TimSort.sortBy Row t -> Row t -> Ordering
cmp MVector s (Row t)
MVector (PrimState (ST s)) (Row t)
mutVec
        MVector (PrimState (ST s)) (Row t) -> ST s (Vector (Row t))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Data.Vector.freeze MVector s (Row t)
MVector (PrimState (ST s)) (Row t)
mutVec ST s (Vector (Row t))
-> (Vector (Row t) -> Vector (Row t)) -> ST s (Vector (Row t))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Vector (Row t) -> Vector (Row t)
forall a. Vector a -> Vector a
Data.Vector.force
{-# INLINABLE sortRowsBy #-}


-- | Sort the rows of a frame using a custom comparison function.
--
-- Use the function `on` from "Data.Function" to easily create 
-- comparison functions. See the example below. 
--
-- If your dataframe has an instance of `Indexable`, see `sortRowsByKey`.
--
-- For example, let's say we want to sort
-- a dataframe of students by their first name:
-- 
-- >>> :{
--      data Student f
--          = MkStudent { studentName      :: Column f String
--                      , studentAge       :: Column f Int
--                      , studentMathGrade :: Column f Char
--                      }
--          deriving (Generic, Frameable)
--      students = fromRows 
--               [ MkStudent "Erika" 13 'D'
--               , MkStudent "Beatrice" 13 'B'
--               , MkStudent "David" 13 'A'
--               , MkStudent "Albert" 12 'C'
--               , MkStudent "Frank" 11 'C'
--               , MkStudent "Clara" 12 'A'
--               ]
-- :}
--
-- >>> import Data.Function (on)
-- >>> putStrLn $ display $ sortRowsBy (compare `on` studentName) students
-- studentName | studentAge | studentMathGrade
-- ----------- | ---------- | ----------------
--    "Albert" |         12 |              'C' 
--  "Beatrice" |         13 |              'B'
--     "Clara" |         12 |              'A'
--     "David" |         13 |              'A'
--     "Erika" |         13 |              'D'
--     "Frank" |         11 |              'C'
--
-- The underlying sorting algorithm is timsort (via 
-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number 
-- of comparisons used.
sortRowsByUnique :: Frameable t
           => (Row t -> Row t -> Ordering)
           -> Frame t
           -> Frame t
sortRowsByUnique :: forall (t :: (* -> *) -> *).
Frameable t =>
(Row t -> Row t -> Ordering) -> Frame t -> Frame t
sortRowsByUnique Row t -> Row t -> Ordering
cmp Frame t
df
    = let rs :: Vector (Row t)
rs = Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t
df 
       in Vector (Row t) -> Frame t
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows (Vector (Row t) -> Frame t) -> Vector (Row t) -> Frame t
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Vector (Row t))) -> Vector (Row t)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (Row t))) -> Vector (Row t))
-> (forall s. ST s (Vector (Row t))) -> Vector (Row t)
forall a b. (a -> b) -> a -> b
$ do
        MVector s (Row t)
mutVec <- Vector (Row t) -> ST s (MVector (PrimState (ST s)) (Row t))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Data.Vector.thaw Vector (Row t)
rs
        (Row t -> Row t -> Ordering)
-> MVector (PrimState (ST s)) (Row t)
-> ST s (MVector (PrimState (ST s)) (Row t))
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
TimSort.sortUniqBy Row t -> Row t -> Ordering
cmp MVector s (Row t)
MVector (PrimState (ST s)) (Row t)
mutVec ST s (MVector s (Row t))
-> (MVector s (Row t) -> ST s (Vector (Row t)))
-> ST s (Vector (Row t))
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector s (Row t) -> ST s (Vector (Row t))
MVector (PrimState (ST s)) (Row t) -> ST s (Vector (Row t))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Data.Vector.freeze ST s (Vector (Row t))
-> (Vector (Row t) -> Vector (Row t)) -> ST s (Vector (Row t))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Vector (Row t) -> Vector (Row t)
forall a. Vector a -> Vector a
Data.Vector.force
{-# INLINABLE sortRowsByUnique #-}


-- | Sort the rows of a frame using the index defined by
-- the `Indexable` typeclass. 
--
-- If your dataframe does not have an instance of `Indexable`, 
-- see `sortRowsBy`.
--
-- To prune rows with duplicate keys, see `sortRowsByKeyUnique`.
-- 
-- For example:
-- 
-- >>> :{
--      data Student f
--          = MkStudent { studentName      :: Column f String
--                      , studentAge       :: Column f Int
--                      , studentMathGrade :: Column f Char
--                      }
--          deriving (Generic, Frameable)
--      instance Indexable Student where
--          type Key Student = String
--          index = studentName
--      students = fromRows 
--               [ MkStudent "Erika" 13 'D'
--               , MkStudent "Beatrice" 13 'B'
--               , MkStudent "David" 13 'A'
--               , MkStudent "Albert" 12 'C'
--               , MkStudent "Frank" 11 'C'
--               , MkStudent "Clara" 12 'A'
--               ]
-- :}
--
-- >>> import Data.Function (on)
-- >>> putStrLn $ display $ sortRowsByKey students
-- studentName | studentAge | studentMathGrade
-- ----------- | ---------- | ----------------
--    "Albert" |         12 |              'C' 
--  "Beatrice" |         13 |              'B'
--     "Clara" |         12 |              'A'
--     "David" |         13 |              'A'
--     "Erika" |         13 |              'D'
--     "Frank" |         11 |              'C'
--
-- The underlying sorting algorithm is timsort (via 
-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number 
-- of comparisons used.
sortRowsByKey :: (Indexable t)
              => Frame t
              -> Frame t
sortRowsByKey :: forall (t :: (* -> *) -> *). Indexable t => Frame t -> Frame t
sortRowsByKey Frame t
df =
    -- I had trouble defining a method whereby one could either
    -- build a vector of keys from a `Frame` (without converting to rows), 
    -- or extract a key from a single `Row`. See "NOTE: Indexable key and index" below
    --
    -- Instead, we extract the index vector, sort it while keeping track
    -- of the initial integer positions, and finally backpermuting.
    let ix :: Vector (Key t, Int)
ix = ((Int, Key t) -> (Key t, Int))
-> Vector (Int, Key t) -> Vector (Key t, Int)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map (Int, Key t) -> (Key t, Int)
forall a b. (a, b) -> (b, a)
swap 
           (Vector (Int, Key t) -> Vector (Key t, Int))
-> Vector (Int, Key t) -> Vector (Key t, Int)
forall a b. (a -> b) -> a -> b
$ Vector (Key t) -> Vector (Int, Key t)
forall a. Vector a -> Vector (Int, a)
Data.Vector.indexed (Frame t -> Vector (Key t)
forall (t :: (* -> *) -> *).
Indexable t =>
Frame t -> Vector (Key t)
index Frame t
df)
        -- TODO: is it possible to run `Data.Vector.map snd` 
        -- within the `ST` context?
        sortedIx :: Vector Int
sortedIx = ((Key t, Int) -> Int) -> Vector (Key t, Int) -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map (Key t, Int) -> Int
forall a b. (a, b) -> b
snd (Vector (Key t, Int) -> Vector Int)
-> Vector (Key t, Int) -> Vector Int
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Vector (Key t, Int))) -> Vector (Key t, Int)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (Key t, Int))) -> Vector (Key t, Int))
-> (forall s. ST s (Vector (Key t, Int))) -> Vector (Key t, Int)
forall a b. (a -> b) -> a -> b
$ do
            MVector s (Key t, Int)
mutVec <- Vector (Key t, Int)
-> ST s (MVector (PrimState (ST s)) (Key t, Int))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Data.Vector.thaw Vector (Key t, Int)
ix
            Comparison (Key t, Int)
-> MVector (PrimState (ST s)) (Key t, Int) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
TimSort.sortBy (Key t -> Key t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Key t -> Key t -> Ordering)
-> ((Key t, Int) -> Key t) -> Comparison (Key t, Int)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Key t, Int) -> Key t
forall a b. (a, b) -> a
fst) MVector s (Key t, Int)
MVector (PrimState (ST s)) (Key t, Int)
mutVec

            MVector (PrimState (ST s)) (Key t, Int)
-> ST s (Vector (Key t, Int))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Data.Vector.freeze MVector s (Key t, Int)
MVector (PrimState (ST s)) (Key t, Int)
mutVec ST s (Vector (Key t, Int))
-> (Vector (Key t, Int) -> Vector (Key t, Int))
-> ST s (Vector (Key t, Int))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Vector (Key t, Int) -> Vector (Key t, Int)
forall a. Vector a -> Vector a
Data.Vector.force
     in Vector (Row t) -> Frame t
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows (Vector (Row t) -> Frame t) -> Vector (Row t) -> Frame t
forall a b. (a -> b) -> a -> b
$ Vector (Row t) -> Vector Int -> Vector (Row t)
forall a. Vector a -> Vector Int -> Vector a
Data.Vector.backpermute (Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t
df) Vector Int
sortedIx --  sortRowsBy (compare `on` index)
{-# INLINABLE sortRowsByKey #-}


-- | Sort the rows of a frame using the index defined by
-- the `Indexable` typeclass, but prune rows with duplicate keys.
--
-- The underlying sorting algorithm is timsort (via 
-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number 
-- of comparisons used.
sortRowsByKeyUnique :: (Indexable t)
                    => Frame t
                    -> Frame t
sortRowsByKeyUnique :: forall (t :: (* -> *) -> *). Indexable t => Frame t -> Frame t
sortRowsByKeyUnique = (Key t -> Key t) -> Frame t -> Frame t
forall k (t :: (* -> *) -> *).
(Ord k, Indexable t) =>
(Key t -> k) -> Frame t -> Frame t
sortRowsByKeyUniqueOn Key t -> Key t
forall a. a -> a
id


-- | Sort the rows of a frame by mapping the index defined by
-- the `Indexable` typeclass, to another key type @k@. 
-- Also prune rows with duplicate keys.
--
-- The underlying sorting algorithm is timsort (via 
-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number 
-- of comparisons used.
sortRowsByKeyUniqueOn :: (Ord k, Indexable t)
                      => (Key t -> k)
                      -> Frame t
                      -> Frame t
sortRowsByKeyUniqueOn :: forall k (t :: (* -> *) -> *).
(Ord k, Indexable t) =>
(Key t -> k) -> Frame t -> Frame t
sortRowsByKeyUniqueOn Key t -> k
mapkey Frame t
df =
    -- I had trouble defining a method whereby one could either
    -- build a vector of keys from a `Frame` (without converting to rows), 
    -- or extract a key from a single `Row`.
    --
    -- Instead, we extract the index vector, sort it while keeping track
    -- of the initial integer positions, and finally backpermuting.
    let ix :: Vector (k, Int)
ix = ((Int, k) -> (k, Int)) -> Vector (Int, k) -> Vector (k, Int)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map (Int, k) -> (k, Int)
forall a b. (a, b) -> (b, a)
swap 
           (Vector (Int, k) -> Vector (k, Int))
-> Vector (Int, k) -> Vector (k, Int)
forall a b. (a -> b) -> a -> b
$ Vector k -> Vector (Int, k)
forall a. Vector a -> Vector (Int, a)
Data.Vector.indexed ((Key t -> k) -> Vector (Key t) -> Vector k
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Key t -> k
mapkey (Vector (Key t) -> Vector k) -> Vector (Key t) -> Vector k
forall a b. (a -> b) -> a -> b
$ Frame t -> Vector (Key t)
forall (t :: (* -> *) -> *).
Indexable t =>
Frame t -> Vector (Key t)
index Frame t
df)
        -- TODO: is it possible to run `Data.Vector.map snd` 
        -- within the `ST` context?
        sortedIx :: Vector Int
sortedIx = ((k, Int) -> Int) -> Vector (k, Int) -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map (k, Int) -> Int
forall a b. (a, b) -> b
snd (Vector (k, Int) -> Vector Int) -> Vector (k, Int) -> Vector Int
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Vector (k, Int))) -> Vector (k, Int)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (k, Int))) -> Vector (k, Int))
-> (forall s. ST s (Vector (k, Int))) -> Vector (k, Int)
forall a b. (a -> b) -> a -> b
$ do
            MVector s (k, Int)
mutVec <- Vector (k, Int) -> ST s (MVector (PrimState (ST s)) (k, Int))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Data.Vector.thaw Vector (k, Int)
ix
            Comparison (k, Int)
-> MVector (PrimState (ST s)) (k, Int)
-> ST s (MVector (PrimState (ST s)) (k, Int))
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
TimSort.sortUniqBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering) -> ((k, Int) -> k) -> Comparison (k, Int)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, Int) -> k
forall a b. (a, b) -> a
fst) MVector s (k, Int)
MVector (PrimState (ST s)) (k, Int)
mutVec ST s (MVector s (k, Int))
-> (MVector s (k, Int) -> ST s (Vector (k, Int)))
-> ST s (Vector (k, Int))
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector s (k, Int) -> ST s (Vector (k, Int))
MVector (PrimState (ST s)) (k, Int) -> ST s (Vector (k, Int))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Data.Vector.freeze ST s (Vector (k, Int))
-> (Vector (k, Int) -> Vector (k, Int)) -> ST s (Vector (k, Int))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Vector (k, Int) -> Vector (k, Int)
forall a. Vector a -> Vector a
Data.Vector.force
     in Vector (Row t) -> Frame t
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows (Vector (Row t) -> Frame t) -> Vector (Row t) -> Frame t
forall a b. (a -> b) -> a -> b
$ Vector (Row t) -> Vector Int -> Vector (Row t)
forall a. Vector a -> Vector Int -> Vector a
Data.Vector.backpermute (Frame t -> Vector (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t
df) Vector Int
sortedIx --  sortRowsBy (compare `on` index)
{-# INLINABLE sortRowsByKeyUniqueOn #-}


-- | Look up a row in a data frame by key. The specific key
-- is defined by the `Indexable` instance of type @t@.
--
-- The first row whose index matches the supplied key is 
-- returned. If no row has a matching key, returns `Nothing`.
--
-- If you need to look up a particular row and column, 
-- `at` is much more efficient.
--
-- To lookup a row based on an integer index, see `ilookup`.
lookup :: (Indexable t)  
       => Key t
       -> Frame t
       -> Maybe (Row t)
lookup :: forall (t :: (* -> *) -> *).
Indexable t =>
Key t -> Frame t -> Maybe (Row t)
lookup Key t
key Frame t
fr 
    = (Key t -> Bool) -> Vector (Key t) -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
Data.Vector.findIndex (Key t -> Key t -> Bool
forall a. Eq a => a -> a -> Bool
==Key t
key) (Frame t -> Vector (Key t)
forall (t :: (* -> *) -> *).
Indexable t =>
Frame t -> Vector (Key t)
index Frame t
fr) 
    Maybe Int -> (Int -> Maybe (Row t)) -> Maybe (Row t)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Frame t -> Maybe (Row t))
-> Frame t -> Int -> Maybe (Row t)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Frame t -> Maybe (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Int -> Frame t -> Maybe (Row t)
ilookup Frame t
fr


-- | Lookup an element of a frame by row and column.
--
-- This is much more efficient than looking up an entire row 
-- using `lookup`, and then selecting a specific field from a row.
--
-- To lookup an element by integer row index instead, see `iat`.
at :: (Indexable t)
   => Frame t 
   -> (Key t, Frame t -> Vector a)
   -> Maybe a
Frame t
fr at :: forall (t :: (* -> *) -> *) a.
Indexable t =>
Frame t -> (Key t, Frame t -> Vector a) -> Maybe a
`at` (Key t
row, Frame t -> Vector a
col) 
    = (Key t -> Bool) -> Vector (Key t) -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
Data.Vector.findIndex (Key t -> Key t -> Bool
forall a. Eq a => a -> a -> Bool
==Key t
row) (Frame t -> Vector (Key t)
forall (t :: (* -> *) -> *).
Indexable t =>
Frame t -> Vector (Key t)
index Frame t
fr)
    Maybe Int -> (Int -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
ix -> (Frame t -> Vector a
col Frame t
fr) Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
Data.Vector.!? Int
ix


-- | Lookup an element of the frame by row index and column
--
-- This is much more efficient than looking up an entire row 
-- using `ilookup`, and then selecting a specific field from a row.
--
-- To lookup an element by row key instead, see `at`.
iat :: Frame t 
    -> (Int, Frame t -> Vector a)
    -> Maybe a
Frame t
fr iat :: forall (t :: (* -> *) -> *) a.
Frame t -> (Int, Frame t -> Vector a) -> Maybe a
`iat` (Int
rowIx, Frame t -> Vector a
col) = (Frame t -> Vector a
col Frame t
fr) Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
Data.Vector.!? Int
rowIx


-- | Merge two dataframes using a merging strategy, where the indexes
-- of the dataframes have the same type. See `mergeWithStrategyOn`
-- to merge dataframes with different indexes.
--
-- A merging strategy handles the possibility of rows missing in the 
-- left and/or right dataframes. Merge strategies can be user-defined,
-- or you can use predefined strategies (e.g. `matchedStrategy`).
--
-- Note that (@`Key` t1 ~ `Key` t2@) means that the type of keys in
-- in both dataframes must be the same.
--
-- In the example below, we have two dataframes: one containing
-- store names, and one containing addresses. Both dataframes
-- have use a unique identification number to relate their data
-- to specific stores.
--
-- We want to build a summary of information about stores,
-- containing each store's name and address.
--
-- >>> :{
--      data Store f
--          = MkStore { storeId   :: Column f Int
--                    , storeName :: Column f String
--                    }
--          deriving (Generic, Frameable)
--      instance Indexable Store where
--          type Key Store = Int
--          index = storeId
-- :}
--
-- >>> :{
--      data Address f
--          = MkAddress { addressStoreId     :: Column f Int
--                      , addressCivicNumber :: Column f Int
--                      , addressStreetName  :: Column f String
--                      }
--          deriving (Generic, Frameable)
--      instance Show (Row Address) where
--          show (MkAddress _ civicNum streetName) = mconcat [show civicNum, " ", streetName]
--      instance Indexable Address where
--          type Key Address = Int
--          index = addressStoreId
-- :}
--
-- >>> :{
--      data StoreSummary f
--          = MkStoreSummary { storeSummaryName    :: Column f String
--                           , storeSummaryAddress :: Column f (Row Address)
--                           }
--          deriving (Generic, Frameable)
--      deriving instance Show (Row StoreSummary)
-- :}
--
-- >>> :{
--     stores = fromRows 
--              [ MkStore 1 "Maxi"
--              , MkStore 2 "Metro"
--              , MkStore 3 "Sobeys"
--              , MkStore 4 "Loblaws"
--              ]
-- :}
--
-- >>> :{
--     addresses = fromRows
--                 [ MkAddress 1 1982 "14th Avenue"
--                 , MkAddress 2 10   "Main Street"
--                 , MkAddress 3 914  "Prima Street"
--                 -- Missing address for store id 4
--                 , MkAddress 5 1600 "Cosgrove Lane"
--                 ]
-- :}
--
-- >>> :{
--      putStrLn
--          $ display
--              $ mergeWithStrategy 
--                    (matchedStrategy (\_ store address -> MkStoreSummary (storeName store) address))
--                    stores
--                    addresses
-- :}
-- storeSummaryName | storeSummaryAddress
-- ---------------- | -------------------
--           "Maxi" |    1982 14th Avenue
--          "Metro" |      10 Main Street
--         "Sobeys" |    914 Prima Street
mergeWithStrategy :: ( Indexable t1, Indexable t2, Frameable t3
                     , Key t1 ~ Key t2
                     )
                  => MergeStrategy (Key t1) t1 t2 t3
                  -> Frame t1
                  -> Frame t2
                  -> Frame t3
mergeWithStrategy :: forall (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *)
       (t3 :: (* -> *) -> *).
(Indexable t1, Indexable t2, Frameable t3, Key t1 ~ Key t2) =>
MergeStrategy (Key t1) t1 t2 t3 -> Frame t1 -> Frame t2 -> Frame t3
mergeWithStrategy = (Key t1 -> Key t2)
-> (Key t2 -> Key t2)
-> MergeStrategy (Key t2) t1 t2 t3
-> t1 Vector
-> t2 Vector
-> t3 Vector
forall k (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *)
       (t3 :: (* -> *) -> *).
(Ord k, Indexable t1, Indexable t2, Frameable t3) =>
(Key t1 -> k)
-> (Key t2 -> k)
-> MergeStrategy k t1 t2 t3
-> Frame t1
-> Frame t2
-> Frame t3
mergeWithStrategyOn Key t1 -> Key t2
Key t2 -> Key t2
forall a. a -> a
id Key t2 -> Key t2
forall a. a -> a
id


-- | Merge two dataframes using a merging strategy, where the indexes
-- of the dataframes are mapped to some key of type @k@.
--
-- See `mergeWithStrategy` for further notes and examples.
mergeWithStrategyOn :: ( Ord k, Indexable t1, Indexable t2, Frameable t3)
                    => (Key t1 -> k) -- ^ How to map the index of the left dataframe onto a key of type @k@
                    -> (Key t2 -> k) -- ^ How to map the index of the right dataframe onto a key of type @k@
                    -> MergeStrategy k t1 t2 t3
                    -> Frame t1
                    -> Frame t2
                    -> Frame t3
mergeWithStrategyOn :: forall k (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *)
       (t3 :: (* -> *) -> *).
(Ord k, Indexable t1, Indexable t2, Frameable t3) =>
(Key t1 -> k)
-> (Key t2 -> k)
-> MergeStrategy k t1 t2 t3
-> Frame t1
-> Frame t2
-> Frame t3
mergeWithStrategyOn Key t1 -> k
mapk1 Key t2 -> k
mapk2 MergeStrategy k t1 t2 t3
strat Frame t1
df1Unsorted Frame t2
df2Unsorted   
    = let df1 :: Frame t1
df1 = (Key t1 -> k) -> Frame t1 -> Frame t1
forall k (t :: (* -> *) -> *).
(Ord k, Indexable t) =>
(Key t -> k) -> Frame t -> Frame t
sortRowsByKeyUniqueOn Key t1 -> k
mapk1 Frame t1
df1Unsorted
          df2 :: Frame t2
df2 = (Key t2 -> k) -> Frame t2 -> Frame t2
forall k (t :: (* -> *) -> *).
(Ord k, Indexable t) =>
(Key t -> k) -> Frame t -> Frame t
sortRowsByKeyUniqueOn Key t2 -> k
mapk2 Frame t2
df2Unsorted
          ix1 :: Vector k
ix1 = (Key t1 -> k) -> Vector (Key t1) -> Vector k
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Key t1 -> k
mapk1 (Vector (Key t1) -> Vector k) -> Vector (Key t1) -> Vector k
forall a b. (a -> b) -> a -> b
$ Frame t1 -> Vector (Key t1)
forall (t :: (* -> *) -> *).
Indexable t =>
Frame t -> Vector (Key t)
index Frame t1
df1
          ix2 :: Vector k
ix2 = (Key t2 -> k) -> Vector (Key t2) -> Vector k
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Key t2 -> k
mapk2 (Vector (Key t2) -> Vector k) -> Vector (Key t2) -> Vector k
forall a b. (a -> b) -> a -> b
$ Frame t2 -> Vector (Key t2)
forall (t :: (* -> *) -> *).
Indexable t =>
Frame t -> Vector (Key t)
index Frame t2
df2
          -- Since df1 and df2 are sorted by key and their keys are unique, we 
          -- can safely use `Set.fromDistinctAscList`.
          fullIx :: Set k
fullIx = ([k] -> Set k
forall a. [a] -> Set a
Set.fromDistinctAscList ([k] -> Set k) -> [k] -> Set k
forall a b. (a -> b) -> a -> b
$ Vector k -> [k]
forall a. Vector a -> [a]
Data.Vector.toList Vector k
ix1) 
                                Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` 
                   ([k] -> Set k
forall a. [a] -> Set a
Set.fromDistinctAscList ([k] -> Set k) -> [k] -> Set k
forall a b. (a -> b) -> a -> b
$ Vector k -> [k]
forall a. Vector a -> [a]
Data.Vector.toList Vector k
ix2)
          
          fullLeft :: Vector (k, Maybe (Row t1))
fullLeft  = Set k -> Vector (k, Row t1) -> Vector (k, Maybe (Row t1))
forall k (t :: (* -> *) -> *).
Ord k =>
Set k -> Vector (k, Row t) -> Vector (k, Maybe (Row t))
reindex Set k
fullIx (Vector k -> Vector (Row t1) -> Vector (k, Row t1)
forall a b. Vector a -> Vector b -> Vector (a, b)
Data.Vector.zip Vector k
ix1 (Frame t1 -> Vector (Row t1)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t1
df1))
          fullRight :: Vector (k, Maybe (Row t2))
fullRight = Set k -> Vector (k, Row t2) -> Vector (k, Maybe (Row t2))
forall k (t :: (* -> *) -> *).
Ord k =>
Set k -> Vector (k, Row t) -> Vector (k, Maybe (Row t))
reindex Set k
fullIx (Vector k -> Vector (Row t2) -> Vector (k, Row t2)
forall a b. Vector a -> Vector b -> Vector (a, b)
Data.Vector.zip Vector k
ix2 (Frame t2 -> Vector (Row t2)
forall (t :: (* -> *) -> *).
Frameable t =>
Frame t -> Vector (Row t)
toRows Frame t2
df2))
       in Vector (Row t3) -> Frame t3
forall (t :: (* -> *) -> *) (f :: * -> *).
(Frameable t, Foldable f) =>
f (Row t) -> Frame t
fromRows (Vector (Row t3) -> Frame t3) -> Vector (Row t3) -> Frame t3
forall a b. (a -> b) -> a -> b
$ Vector (Maybe (Row t3)) -> Vector (Row t3)
forall a. Vector (Maybe a) -> Vector a
Data.Vector.catMaybes 
                   (Vector (Maybe (Row t3)) -> Vector (Row t3))
-> Vector (Maybe (Row t3)) -> Vector (Row t3)
forall a b. (a -> b) -> a -> b
$ ((k, Maybe (Row t1)) -> (k, Maybe (Row t2)) -> Maybe (Row t3))
-> Vector (k, Maybe (Row t1))
-> Vector (k, Maybe (Row t2))
-> Vector (Maybe (Row t3))
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Data.Vector.zipWith (\(k, Maybe (Row t1))
t1 (k, Maybe (Row t2))
t2 -> MergeStrategy k t1 t2 t3
-> (k, These (Row t1) (Row t2)) -> Maybe (Row t3)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MergeStrategy k t1 t2 t3
strat ((k, Maybe (Row t1))
-> (k, Maybe (Row t2)) -> (k, These (Row t1) (Row t2))
forall k a b.
Eq k =>
(k, Maybe a) -> (k, Maybe b) -> (k, These a b)
asThese (k, Maybe (Row t1))
t1 (k, Maybe (Row t2))
t2))
                                         Vector (k, Maybe (Row t1))
fullLeft
                                         Vector (k, Maybe (Row t2))
fullRight
    
    where
        asThese :: Eq k => (k, Maybe a) -> (k, Maybe b) -> (k, These a b)
        asThese :: forall k a b.
Eq k =>
(k, Maybe a) -> (k, Maybe b) -> (k, These a b)
asThese (k
k1, Just a
a) (k
k2, Maybe b
Nothing) = Bool -> (k, These a b) -> (k, These a b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (k
k1k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k2) (k
k1, a -> These a b
forall a b. a -> These a b
This a
a)
        asThese (k
k1, Maybe a
Nothing) (k
k2, Just b
b) = Bool -> (k, These a b) -> (k, These a b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (k
k1k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k2) (k
k1, b -> These a b
forall a b. b -> These a b
That b
b)
        asThese (k
k1, Just a
a) (k
k2, Just b
b)  = Bool -> (k, These a b) -> (k, These a b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (k
k1k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k2) (k
k1, a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)
        -- The following line is unreachable since we know that the key `k`
        -- will be present in at least one of the two rows.
        asThese (k, Maybe a)
_ (k, Maybe b)
_ = [Char] -> (k, These a b)
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"impossible"
        
        reindex :: Ord k => Set.Set k -> Vector (k, Row t) -> Vector (k, Maybe (Row t))
        reindex :: forall k (t :: (* -> *) -> *).
Ord k =>
Set k -> Vector (k, Row t) -> Vector (k, Maybe (Row t))
reindex Set k
fullix Vector (k, Row t)
vs = Int -> [(k, Maybe (Row t))] -> Vector (k, Maybe (Row t))
forall a. Int -> [a] -> Vector a
Data.Vector.fromListN (Set k -> Int
forall a. Set a -> Int
Set.size Set k
fullix) 
                          ([(k, Maybe (Row t))] -> Vector (k, Maybe (Row t)))
-> [(k, Maybe (Row t))] -> Vector (k, Maybe (Row t))
forall a b. (a -> b) -> a -> b
$ Seq (k, Maybe (Row t)) -> [(k, Maybe (Row t))]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList 
                          (Seq (k, Maybe (Row t)) -> [(k, Maybe (Row t))])
-> Seq (k, Maybe (Row t)) -> [(k, Maybe (Row t))]
forall a b. (a -> b) -> a -> b
$ Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
forall k (t :: (* -> *) -> *).
Ord k =>
Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
go Seq (k, Maybe (Row t))
forall a. Seq a
Empty 
                               ([k] -> Seq k
forall a. [a] -> Seq a
Seq.fromList ([k] -> Seq k) -> [k] -> Seq k
forall a b. (a -> b) -> a -> b
$ Set k -> [k]
forall a. Set a -> [a]
Set.toAscList Set k
fullix) 
                               ([(k, Row t)] -> Seq (k, Row t)
forall a. [a] -> Seq a
Seq.fromList ([(k, Row t)] -> Seq (k, Row t)) -> [(k, Row t)] -> Seq (k, Row t)
forall a b. (a -> b) -> a -> b
$ Vector (k, Row t) -> [(k, Row t)]
forall a. Vector a -> [a]
Data.Vector.toList Vector (k, Row t)
vs)
            where
                -- We use `Seq` for the O(1) append
                -- Note that this function REQUIRES the rows to be sorted in
                -- ascending values of their key
                go :: Ord k 
                   => Seq (k, Maybe (Row t)) -- Accumulator
                   -> Seq k                  -- Full index
                   -> Seq (k, Row t)         -- Rows
                   -> Seq (k, Maybe (Row t))
                go :: forall k (t :: (* -> *) -> *).
Ord k =>
Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
go Seq (k, Maybe (Row t))
acc Seq k
Empty Seq (k, Row t)
_ = Seq (k, Maybe (Row t))
acc
                go Seq (k, Maybe (Row t))
acc Seq k
keys Seq (k, Row t)
Empty = Seq (k, Maybe (Row t))
acc Seq (k, Maybe (Row t))
-> Seq (k, Maybe (Row t)) -> Seq (k, Maybe (Row t))
forall a. Seq a -> Seq a -> Seq a
Seq.>< (k -> (k, Maybe (Row t))) -> Seq k -> Seq (k, Maybe (Row t))
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Maybe (Row t)
forall a. Maybe a
Nothing) Seq k
keys
                go Seq (k, Maybe (Row t))
acc (k
k:<|Seq k
ks) queue :: Seq (k, Row t)
queue@((k
rk, Row t
row):<|Seq (k, Row t)
rs) = case k
k k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
rk of
                    Ordering
EQ -> Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
forall k (t :: (* -> *) -> *).
Ord k =>
Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
go (Seq (k, Maybe (Row t))
acc Seq (k, Maybe (Row t))
-> (k, Maybe (Row t)) -> Seq (k, Maybe (Row t))
forall a. Seq a -> a -> Seq a
Seq.|> (k
k, Row t -> Maybe (Row t)
forall a. a -> Maybe a
Just Row t
row)) Seq k
ks Seq (k, Row t)
rs
                    Ordering
LT -> Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
forall k (t :: (* -> *) -> *).
Ord k =>
Seq (k, Maybe (Row t))
-> Seq k -> Seq (k, Row t) -> Seq (k, Maybe (Row t))
go (Seq (k, Maybe (Row t))
acc Seq (k, Maybe (Row t))
-> (k, Maybe (Row t)) -> Seq (k, Maybe (Row t))
forall a. Seq a -> a -> Seq a
Seq.|> (k
k, Maybe (Row t)
forall a. Maybe a
Nothing)) Seq k
ks Seq (k, Row t)
queue
                    -- Since the full index includes all keys, it's not possible
                    -- the following case
                    Ordering
GT -> [Char] -> Seq (k, Maybe (Row t))
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"impossible"


-- | A merge strategy is a function that describes how to
-- merge two rows together.
--
-- A merge strategy must handle three cases:
-- 
-- * Only the left row (v`This`);
-- * Only the right row (v`That`);
-- * Both the left and right rows (v`These`).
--
-- The simplest merge strategy is `matchedStrategy`. 
--
-- See examples in the documentation of `mergeWithStrategy`.
type MergeStrategy k t1 t2 t3
    = (k -> These (Row t1) (Row t2) -> Maybe (Row t3))


-- | Merge strategy which only works if both the left and right
-- rows are found.
--
-- If you are familiar with relational databases, `matchedStrategy`
-- is an inner join.
matchedStrategy :: (k -> Row t1 -> Row t2 -> Row t3)
                -> MergeStrategy k t1 t2 t3
matchedStrategy :: forall k (t1 :: (* -> *) -> *) (t2 :: (* -> *) -> *)
       (t3 :: (* -> *) -> *).
(k -> Row t1 -> Row t2 -> Row t3) -> MergeStrategy k t1 t2 t3
matchedStrategy k -> Row t1 -> Row t2 -> Row t3
f k
k (These Row t1
r1 Row t2
r2) = Row t3 -> Maybe (Row t3)
forall a. a -> Maybe a
Just (Row t3 -> Maybe (Row t3)) -> Row t3 -> Maybe (Row t3)
forall a b. (a -> b) -> a -> b
$ k -> Row t1 -> Row t2 -> Row t3
f k
k Row t1
r1 Row t2
r2
matchedStrategy k -> Row t1 -> Row t2 -> Row t3
_ k
_ These (Row t1) (Row t2)
_ = Maybe (Row t3)
forall a. Maybe a
Nothing


-- | Type family which allows for higher-kinded record types
-- in two forms:
--
-- * Single record type using t`Identity`, where @`Column` Identity a ~ a@ ;
-- * Record type whose elements are some other functor (usually `Vector`).
--
-- Types are created like regular record types, but each element
-- must have the type @`Column` f a@ instead of @a@. For example:
--
-- >>> :{
--      data Student f
--          = MkStudent { studentName      :: Column f String
--                      , studentAge       :: Column f Int
--                      , studentMathGrade :: Column f Char
--                      }
--          deriving (Generic, Frameable)
-- :}
type family Column (f :: Type -> Type) x where
    Column Identity x = x
    Column f x        = f x

-- | Type synonym for a record type with scalar elements
type Row (dt :: (Type -> Type) -> Type) = dt Identity

-- | Type synonym for a record type whose elements are arrays (columns)
type Frame (dt :: (Type -> Type) -> Type) = dt Vector


-- | Typeclass to generically derive the function `fromRows`.
class GFromRows tI tV where
    gfromRows :: Vector (tI a) -> (tV a)

instance GFromRows (Rec0 a) (Rec0 (Vector a)) where
    gfromRows :: forall (a :: k). Vector (Rec0 a a) -> Rec0 (Vector a) a
gfromRows = Vector a -> K1 R (Vector a) a
forall k i c (p :: k). c -> K1 i c p
K1 (Vector a -> K1 R (Vector a) a)
-> (Vector (Rec0 a a) -> Vector a)
-> Vector (Rec0 a a)
-> K1 R (Vector a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rec0 a a -> a) -> Vector (Rec0 a a) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Rec0 a a -> a
forall k i c (p :: k). K1 i c p -> c
unK1
    {-# INLINEABLE gfromRows #-}

instance (GFromRows tI1 tV1, GFromRows tI2 tV2) 
    => GFromRows (tI1 :*: tI2) (tV1 :*: tV2) where
    gfromRows :: forall (a :: k). Vector ((:*:) tI1 tI2 a) -> (:*:) tV1 tV2 a
gfromRows Vector ((:*:) tI1 tI2 a)
vs = let (Vector (tI1 a)
xs, Vector (tI2 a)
ys) = Vector (tI1 a, tI2 a) -> (Vector (tI1 a), Vector (tI2 a))
forall a b. Vector (a, b) -> (Vector a, Vector b)
Data.Vector.unzip (Vector (tI1 a, tI2 a) -> (Vector (tI1 a), Vector (tI2 a)))
-> Vector (tI1 a, tI2 a) -> (Vector (tI1 a), Vector (tI2 a))
forall a b. (a -> b) -> a -> b
$ ((:*:) tI1 tI2 a -> (tI1 a, tI2 a))
-> Vector ((:*:) tI1 tI2 a) -> Vector (tI1 a, tI2 a)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map (\(tI1 a
x :*: tI2 a
y) -> (tI1 a
x, tI2 a
y)) Vector ((:*:) tI1 tI2 a)
vs
                    in Vector (tI1 a) -> tV1 a
forall (a :: k). Vector (tI1 a) -> tV1 a
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GFromRows tI tV =>
Vector (tI a) -> tV a
gfromRows Vector (tI1 a)
xs tV1 a -> tV2 a -> (:*:) tV1 tV2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Vector (tI2 a) -> tV2 a
forall (a :: k). Vector (tI2 a) -> tV2 a
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GFromRows tI tV =>
Vector (tI a) -> tV a
gfromRows Vector (tI2 a)
ys
    {-# INLINEABLE gfromRows #-}

instance GFromRows tI tV => GFromRows (M1 i c tI) (M1 i c tV) where
    gfromRows :: forall (a :: k). Vector (M1 i c tI a) -> M1 i c tV a
gfromRows Vector (M1 i c tI a)
vs = tV a -> M1 i c tV a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Vector (tI a) -> tV a
forall (a :: k). Vector (tI a) -> tV a
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GFromRows tI tV =>
Vector (tI a) -> tV a
gfromRows ((M1 i c tI a -> tI a) -> Vector (M1 i c tI a) -> Vector (tI a)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map M1 i c tI a -> tI a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 Vector (M1 i c tI a)
vs))
    {-# INLINEABLE gfromRows #-}


-- | Typeclass to generically derive the function `toRows`.
class GToRows tI tV where
    gtoRows :: tV a -> Vector (tI a)

instance GToRows (Rec0 a) (Rec0 (Vector a)) where
    gtoRows :: forall (a :: k). Rec0 (Vector a) a -> Vector (Rec0 a a)
gtoRows = (a -> Rec0 a a) -> Vector a -> Vector (Rec0 a a)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map a -> Rec0 a a
forall k i c (p :: k). c -> K1 i c p
K1 (Vector a -> Vector (Rec0 a a))
-> (Rec0 (Vector a) a -> Vector a)
-> Rec0 (Vector a) a
-> Vector (Rec0 a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec0 (Vector a) a -> Vector a
forall k i c (p :: k). K1 i c p -> c
unK1
    {-# INLINEABLE gtoRows #-}

instance (GToRows tI1 tV1, GToRows tI2 tV2) 
    => GToRows (tI1 :*: tI2) (tV1 :*: tV2) where
    gtoRows :: forall (a :: k). (:*:) tV1 tV2 a -> Vector ((:*:) tI1 tI2 a)
gtoRows (tV1 a
xs :*: tV2 a
ys) = (tI1 a -> tI2 a -> (:*:) tI1 tI2 a)
-> Vector (tI1 a) -> Vector (tI2 a) -> Vector ((:*:) tI1 tI2 a)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Data.Vector.zipWith tI1 a -> tI2 a -> (:*:) tI1 tI2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (tV1 a -> Vector (tI1 a)
forall (a :: k). tV1 a -> Vector (tI1 a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GToRows tI tV =>
tV a -> Vector (tI a)
gtoRows tV1 a
xs) (tV2 a -> Vector (tI2 a)
forall (a :: k). tV2 a -> Vector (tI2 a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GToRows tI tV =>
tV a -> Vector (tI a)
gtoRows tV2 a
ys)
    {-# INLINEABLE gtoRows #-}

instance (GToRows tI tV) => GToRows (M1 i c tI) (M1 i c tV) where
    -- gtoRows :: M1 i c tV a -> Vector (M1 i c tI a)
    gtoRows :: forall (a :: k). M1 i c tV a -> Vector (M1 i c tI a)
gtoRows = (tI a -> M1 i c tI a) -> Vector (tI a) -> Vector (M1 i c tI a)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map tI a -> M1 i c tI a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Vector (tI a) -> Vector (M1 i c tI a))
-> (M1 i c tV a -> Vector (tI a))
-> M1 i c tV a
-> Vector (M1 i c tI a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tV a -> Vector (tI a)
forall (a :: k). tV a -> Vector (tI a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GToRows tI tV =>
tV a -> Vector (tI a)
gtoRows (tV a -> Vector (tI a))
-> (M1 i c tV a -> tV a) -> M1 i c tV a -> Vector (tI a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c tV a -> tV a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINEABLE gtoRows #-}

class GILookup tI tV where
    gilookup :: Int -> tV a -> Maybe (tI a)

instance GILookup (Rec0 a) (Rec0 (Vector a)) where
    gilookup :: forall (a :: k). Int -> Rec0 (Vector a) a -> Maybe (Rec0 a a)
gilookup Int
ix Rec0 (Vector a) a
vs = a -> K1 R a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a a) -> Maybe a -> Maybe (K1 R a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rec0 (Vector a) a -> Vector a
forall k i c (p :: k). K1 i c p -> c
unK1 Rec0 (Vector a) a
vs) Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
Data.Vector.!? Int
ix

instance (GILookup tI1 tV1, GILookup tI2 tV2)
    => GILookup (tI1 :*: tI2) (tV1 :*: tV2) where
        gilookup :: forall (a :: k). Int -> (:*:) tV1 tV2 a -> Maybe ((:*:) tI1 tI2 a)
gilookup Int
ix (tV1 a
xs :*: tV2 a
ys) 
            = tI1 a -> tI2 a -> (:*:) tI1 tI2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) 
                (tI1 a -> tI2 a -> (:*:) tI1 tI2 a)
-> Maybe (tI1 a) -> Maybe (tI2 a -> (:*:) tI1 tI2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> tV1 a -> Maybe (tI1 a)
forall (a :: k). Int -> tV1 a -> Maybe (tI1 a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GILookup tI tV =>
Int -> tV a -> Maybe (tI a)
gilookup Int
ix tV1 a
xs) 
                Maybe (tI2 a -> (:*:) tI1 tI2 a)
-> Maybe (tI2 a) -> Maybe ((:*:) tI1 tI2 a)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> tV2 a -> Maybe (tI2 a)
forall (a :: k). Int -> tV2 a -> Maybe (tI2 a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GILookup tI tV =>
Int -> tV a -> Maybe (tI a)
gilookup Int
ix tV2 a
ys)

instance (GILookup tI tV) => GILookup (M1 i c tI) (M1 i c tV) where
    gilookup :: forall (a :: k). Int -> M1 i c tV a -> Maybe (M1 i c tI a)
gilookup Int
ix = (tI a -> M1 i c tI a) -> Maybe (tI a) -> Maybe (M1 i c tI a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap tI a -> M1 i c tI a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Maybe (tI a) -> Maybe (M1 i c tI a))
-> (M1 i c tV a -> Maybe (tI a))
-> M1 i c tV a
-> Maybe (M1 i c tI a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> tV a -> Maybe (tI a)
forall (a :: k). Int -> tV a -> Maybe (tI a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GILookup tI tV =>
Int -> tV a -> Maybe (tI a)
gilookup Int
ix (tV a -> Maybe (tI a))
-> (M1 i c tV a -> tV a) -> M1 i c tV a -> Maybe (tI a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c tV a -> tV a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1


class GFields r where
    gfields :: r a -> [(String, String)]

instance GFields r => GFields (M1 D x r) where
    gfields :: forall (a :: k). M1 D x r a -> [([Char], [Char])]
gfields = r a -> [([Char], [Char])]
forall (a :: k). r a -> [([Char], [Char])]
forall {k} (r :: k -> *) (a :: k).
GFields r =>
r a -> [([Char], [Char])]
gfields (r a -> [([Char], [Char])])
-> (M1 D x r a -> r a) -> M1 D x r a -> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D x r a -> r a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 

instance GFields t => GFields (M1 C x t) where
    gfields :: forall (a :: k). M1 C x t a -> [([Char], [Char])]
gfields = t a -> [([Char], [Char])]
forall (a :: k). t a -> [([Char], [Char])]
forall {k} (r :: k -> *) (a :: k).
GFields r =>
r a -> [([Char], [Char])]
gfields (t a -> [([Char], [Char])])
-> (M1 C x t a -> t a) -> M1 C x t a -> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C x t a -> t a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 

instance (Show r, Selector s) => GFields (M1 S s (Rec0 r)) where
    gfields :: forall (a :: k). M1 S s (Rec0 r) a -> [([Char], [Char])]
gfields (M1 (K1 r
r)) = [(M1 S s (Rec0 r) () -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName (M1 S s (Rec0 r) ()
forall a. (?callStack::CallStack) => a
undefined :: M1 S s (Rec0 r) ()), r -> [Char]
forall a. Show a => a -> [Char]
show r
r)]

instance (GFields f, GFields g) => GFields (f :*: g) where
    gfields :: forall (a :: k). (:*:) f g a -> [([Char], [Char])]
gfields (f a
x :*: g a
y) = f a -> [([Char], [Char])]
forall (a :: k). f a -> [([Char], [Char])]
forall {k} (r :: k -> *) (a :: k).
GFields r =>
r a -> [([Char], [Char])]
gfields f a
x [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
forall a. [a] -> [a] -> [a]
++ g a -> [([Char], [Char])]
forall (a :: k). g a -> [([Char], [Char])]
forall {k} (r :: k -> *) (a :: k).
GFields r =>
r a -> [([Char], [Char])]
gfields g a
y

-- | Typeclass that endows any record type @t@ with the ability to be packaged
-- as a dataframe.
--
-- Under no circumstances should you write instances for `Frameable`; instead,
-- simply derive an instance of `Generic` for @t@. For example:
--
-- >>> :set -XDeriveAnyClass
-- >>> :{
--     data Store f
--          = MkStore { storeName    :: Column f String
--                    , storeId      :: Column f Int
--                    , storeAddress :: Column f String
--                    }
--          deriving (Generic, Frameable)
-- :}
class Frameable t where

    -- | Package single rows of type @t@ into a @`Frame` t@.
    pack :: Vector (Row t) -> Frame t
    
    default pack :: ( Generic (Row t)
                    , Generic (Frame t)
                    , GFromRows (Rep (Row t)) (Rep (Frame t))
                    ) 
                    => Vector (Row t) 
                    -> Frame t
    pack = Rep (Frame t) Any -> Frame t
forall a x. Generic a => Rep a x -> a
forall x. Rep (Frame t) x -> Frame t
to (Rep (Frame t) Any -> Frame t)
-> (Vector (Row t) -> Rep (Frame t) Any)
-> Vector (Row t)
-> Frame t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Rep (Row t) Any) -> Rep (Frame t) Any
forall a. Vector (Rep (Row t) a) -> Rep (Frame t) a
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GFromRows tI tV =>
Vector (tI a) -> tV a
gfromRows (Vector (Rep (Row t) Any) -> Rep (Frame t) Any)
-> (Vector (Row t) -> Vector (Rep (Row t) Any))
-> Vector (Row t)
-> Rep (Frame t) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row t -> Rep (Row t) Any)
-> Vector (Row t) -> Vector (Rep (Row t) Any)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Row t -> Rep (Row t) Any
forall x. Row t -> Rep (Row t) x
forall a x. Generic a => a -> Rep a x
from
    {-# INLINABLE pack #-}

    -- | Unpack a dataframe into rows
    unpack :: Frame t -> Vector (Row t)
    
    default unpack :: ( Generic (Row t)
                      , Generic (Frame t)
                      , GToRows (Rep (Row t)) (Rep (Frame t))
                      ) 
                     => Frame t 
                     -> Vector (Row t) 
    unpack = (Rep (Row t) Any -> Row t)
-> Vector (Rep (Row t) Any) -> Vector (Row t)
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map Rep (Row t) Any -> Row t
forall a x. Generic a => Rep a x -> a
forall x. Rep (Row t) x -> Row t
to (Vector (Rep (Row t) Any) -> Vector (Row t))
-> (Frame t -> Vector (Rep (Row t) Any))
-> Frame t
-> Vector (Row t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep (Frame t) Any -> Vector (Rep (Row t) Any)
forall a. Rep (Frame t) a -> Vector (Rep (Row t) a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GToRows tI tV =>
tV a -> Vector (tI a)
gtoRows (Rep (Frame t) Any -> Vector (Rep (Row t) Any))
-> (Frame t -> Rep (Frame t) Any)
-> Frame t
-> Vector (Rep (Row t) Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t -> Rep (Frame t) Any
forall x. Frame t -> Rep (Frame t) x
forall a x. Generic a => a -> Rep a x
from
    {-# INLINABLE unpack #-}


    -- | Look up a row from the frame by integer index
    iindex :: Int -> Frame t -> Maybe (Row t)

    default iindex :: ( Generic (Frame t)
                      , Generic (Row t)
                      , GILookup (Rep (Row t)) (Rep (Frame t))
                      )
                    => Int
                    -> Frame t
                    -> Maybe (Row t)
    iindex Int
ix = (Rep (Row t) Any -> Row t)
-> Maybe (Rep (Row t) Any) -> Maybe (Row t)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep (Row t) Any -> Row t
forall a x. Generic a => Rep a x -> a
forall x. Rep (Row t) x -> Row t
to (Maybe (Rep (Row t) Any) -> Maybe (Row t))
-> (Frame t -> Maybe (Rep (Row t) Any)) -> Frame t -> Maybe (Row t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rep (Frame t) Any -> Maybe (Rep (Row t) Any)
forall a. Int -> Rep (Frame t) a -> Maybe (Rep (Row t) a)
forall {k} (tI :: k -> *) (tV :: k -> *) (a :: k).
GILookup tI tV =>
Int -> tV a -> Maybe (tI a)
gilookup Int
ix (Rep (Frame t) Any -> Maybe (Rep (Row t) Any))
-> (Frame t -> Rep (Frame t) Any)
-> Frame t
-> Maybe (Rep (Row t) Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame t -> Rep (Frame t) Any
forall x. Frame t -> Rep (Frame t) x
forall a x. Generic a => a -> Rep a x
from

    -- | Return the field names associated with a row or frame.
    -- This is useful to display frames via `display`.
    fields :: Row t -> [(String, String)]
    
    default fields :: ( Generic (Row t)
                      , GFields (Rep (Row t))
                      )
                   => Row t
                   -> [(String, String)]
    fields = Rep (Row t) Any -> [([Char], [Char])]
forall a. Rep (Row t) a -> [([Char], [Char])]
forall {k} (r :: k -> *) (a :: k).
GFields r =>
r a -> [([Char], [Char])]
gfields (Rep (Row t) Any -> [([Char], [Char])])
-> (Row t -> Rep (Row t) Any) -> Row t -> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row t -> Rep (Row t) Any
forall x. Row t -> Rep (Row t) x
forall a x. Generic a => a -> Rep a x
from


-- | Typeclass for dataframes with an index, a column or set of columns that can 
-- be used to search through rows.
--
-- An index need not be unique, but the type of its keys must be an instance of `Eq`.
class ( Frameable t
      , Eq (Key t) -- Effectively required for lookups
      , Ord (Key t) -- Effectively required for joins
      ) => Indexable t where

    -- | A type representing a lookup key for a dataframe.
    -- This can be a single field, or a compound key composed
    -- of multiple fields
    type Key t

    -- | How to create an index from a frame (@`Frame` t@). 
    -- This is generally done by using record selectors.
    index :: Frame t -> Vector (Key t)

{- NOTE: Indexable key and index

Ideally, the `Indexable` class provides two methods:

* key   :: Row t   -> Key t
* index :: Frame t -> Vector (Key t)

However, asking users to implement both methods is redundant and 
could lead to errors, since both methods must be coherent 
with each other. Consider the following example:

@
data Person f
    = MkPerson { firstName :: Column f String
               , lastName  :: Column f String
               }
    deriving (Generic, Frameable)

instance Indexable Person where
    type Key Person = String
    key = firstName
    index = lastName -- oops
@

We could instead use the `key` function to build the `index`, but this requires
converting a `Frame t` to rows, which is wasteful:

class Indexable t where
    type Key t

    key :: Row t -> Key t

    index :: Frame t -> Vector (Key t)
    index = Data.Vector.fromList . map key . toRows

Ideally, we would have a single method in the `Indexable` class:

@
class Indexable t where
    type Key t

    index :: t f -> Column f (Key t)
@

which would work for both f=t`Identity` and f=`Vector`. This actually works
for simple record selectors, e.g.:

@
instance Indexable Person where
    type Key Person = String
    index :: Person f -> Column f (Key Person)
    index = firstName
@

The problem arises with compound keys. How would you write this?

@
instance Indexable Person where
    type Key Person = (String, String)
    index :: Person f -> Column f (Key Person)
    -- Implementation for `Row t`:
    index row = (,) <$> firstName row <*> lastName row
    -- implementation for `Frame t`:
    index frame = Data.Vector.zipWith (,) (firstName frame) (lastName frame)
@

We can unify the signature of `index` in this case with:

@
    index x = compound (firstName x, lastName x)
        where
            compound :: ( Person f -> Column f a
                        , Person f -> Column f b
                        )
                     -> Person f
                     -> Column f (a, b)
@

We can create a typeclass to do this (and implement instances for f=t`Identity`
and f=`Vector`):

@
class Compound f where
    compound :: ( Person f -> Column f a
                , Person f -> Column f b
                )
                -> Person f
                -> Column f (a, b)

instance Compound Identity where
    compound (f, g) x = (f x, g x)

instance Compound Vector where
    compound (f, g) x = Data.Vector.zipWith (,) (f x) (g x)
@

Unfortunately, even with AllowAmbiguousTypes, I haven't been able to write 
an instance where type inference worked, e.g.:

@
instance Indexable Person where
    type Key Person = (String, String)

    index :: Compound f => Person f -> Column f (Key Person)
    index = compound (firstName, lastName)
@

-}


-- | Control how `displayWith` behaves.
data DisplayOptions t
    = DisplayOptions
    { forall (t :: (* -> *) -> *). DisplayOptions t -> Int
maximumNumberOfRows  :: Int
    -- ^ Maximum number of rows shown. These rows will be distributed evenly
    -- between the start of the frame and the end
    , forall (t :: (* -> *) -> *).
DisplayOptions t -> Row t -> [([Char], [Char])]
rowDisplayFunction :: Row t -> [(String, String)]
    -- ^ Function used to display rows from the frame. This should be a map from
    -- record name to value.
    }


-- | Default @`Frame` t@ display options.
defaultDisplayOptions :: Frameable t => DisplayOptions t
defaultDisplayOptions :: forall (t :: (* -> *) -> *). Frameable t => DisplayOptions t
defaultDisplayOptions 
    = DisplayOptions { maximumNumberOfRows :: Int
maximumNumberOfRows  = Int
6
                     , rowDisplayFunction :: Row t -> [([Char], [Char])]
rowDisplayFunction = Row t -> [([Char], [Char])]
forall (t :: (* -> *) -> *).
Frameable t =>
Row t -> [([Char], [Char])]
fields
                     }


-- | Display a @`Frame` t@ using default t'DisplayOptions'.
--
-- Although this is up to you, we strongly recommend that the `Show` 
-- instance for @`Frame` t@ be:
--
-- @
-- instance Show (Frame t) where show = display
-- @
--
-- Example:
-- 
-- >>> :{
--      data Student f
--          = MkStudent { studentName      :: Column f String
--                      , studentAge       :: Column f Int
--                      , studentMathGrade :: Column f Char
--                      }
--          deriving (Generic, Frameable)
-- :}
--
-- >>> students = fromRows $ Vector.fromList [MkStudent "Albert" 12 'C', MkStudent "Beatrice" 13 'B', MkStudent "Clara" 12 'A']
-- >>> putStrLn (display students)
-- studentName | studentAge | studentMathGrade
-- ----------- | ---------- | ----------------
--    "Albert" |         12 |              'C' 
--  "Beatrice" |         13 |              'B'
--     "Clara" |         12 |              'A'
display :: Frameable t
        => Frame t
        -> String
display :: forall (t :: (* -> *) -> *). Frameable t => Frame t -> [Char]
display = DisplayOptions t -> Frame t -> [Char]
forall (t :: (* -> *) -> *).
Frameable t =>
DisplayOptions t -> Frame t -> [Char]
displayWith DisplayOptions t
forall (t :: (* -> *) -> *). Frameable t => DisplayOptions t
defaultDisplayOptions


-- | Display a @`Frame` t@ using custom t'DisplayOptions'.
--
-- Example:
-- 
-- >>> :{
--      data Student f
--          = MkStudent { studentName      :: Column f String
--                      , studentAge       :: Column f Int
--                      , studentMathGrade :: Column f Char
--                      }
--          deriving (Generic, Frameable)
-- :}
--
-- >>> :{
--     students = fromRows 
--              $ Vector.fromList 
--              [ MkStudent "Albert" 12 'C'
--              , MkStudent "Beatrice" 13 'B'
--              , MkStudent "Clara" 12 'A'
--              , MkStudent "David" 13 'A'
--              , MkStudent "Erika" 13 'D'
--              , MkStudent "Frank" 11 'C'
--              ]
-- :}
--
-- >>> putStrLn (displayWith (defaultDisplayOptions{maximumNumberOfRows=2}) students)
-- studentName | studentAge | studentMathGrade
-- ----------- | ---------- | ----------------
--    "Albert" |         12 |              'C' 
--         ... |        ... |              ...
--     "Frank" |         11 |              'C'
displayWith :: (Frameable t)
            => DisplayOptions t
            -> Frame t
            -> String
displayWith :: forall (t :: (* -> *) -> *).
Frameable t =>
DisplayOptions t -> Frame t -> [Char]
displayWith DisplayOptions{Int
Row t -> [([Char], [Char])]
maximumNumberOfRows :: forall (t :: (* -> *) -> *). DisplayOptions t -> Int
rowDisplayFunction :: forall (t :: (* -> *) -> *).
DisplayOptions t -> Row t -> [([Char], [Char])]
maximumNumberOfRows :: Int
rowDisplayFunction :: Row t -> [([Char], [Char])]
..} Frame t
df 
    = if Frame t -> Bool
forall (t :: (* -> *) -> *). Frameable t => Frame t -> Bool
null Frame t
df
        then [Char]
"<Empty dataframe>" -- TODO: it IS possible to determine the record names
                                 --       without having any rows, but it requires
                                 --       an additional generic typeclass
        else [[([Char], [Char])]] -> [Char]
formatGrid [[([Char], [Char])]]
rows

    where
        len :: Int
len = Frame t -> Int
forall (t :: (* -> *) -> *). Frameable t => Frame t -> Int
length Frame t
df
        n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
maximumNumberOfRows Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
        -- We prevent overlap between the 'head' rows and 'tail' rows
        -- by favoring removing duplicate integer indices from the tail rows
        headIxs :: Set Int
headIxs = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        tailIxs :: Set Int
tailIxs = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n ..Int
len] Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
headIxs
        headRows :: [Row t]
headRows = [Maybe (Row t)] -> [Row t]
forall a. [Maybe a] -> [a]
catMaybes [Int -> Frame t -> Maybe (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Int -> Frame t -> Maybe (Row t)
ilookup Int
i Frame t
df | Int
i <- Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
headIxs]
        tailRows :: [Row t]
tailRows = [Maybe (Row t)] -> [Row t]
forall a. [Maybe a] -> [a]
catMaybes [Int -> Frame t -> Maybe (Row t)
forall (t :: (* -> *) -> *).
Frameable t =>
Int -> Frame t -> Maybe (Row t)
ilookup Int
j Frame t
df | Int
j <- Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
tailIxs]

        firstRow :: Row t
firstRow = case [Row t]
headRows of
            [] -> [Char] -> Row t
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Impossible!" -- We already checked that `df` won't be empty
            [Row t
xs] -> Row t
xs
            (Row t
xs:[Row t]
_) -> Row t
xs

        spacerRow :: [[([Char], [Char])]]
spacerRow = 
            if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maximumNumberOfRows
                then [((([Char], [Char]) -> ([Char], [Char]))
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([Char] -> [Char] -> [Char]
forall a b. a -> b -> a
const [Char]
"...")) (Row t -> [([Char], [Char])]
forall (t :: (* -> *) -> *).
Frameable t =>
Row t -> [([Char], [Char])]
fields Row t
firstRow))]
                else [[([Char], [Char])]]
forall a. Monoid a => a
mempty
        rows :: [[([Char], [Char])]]
rows = (Row t -> [([Char], [Char])]
forall (t :: (* -> *) -> *).
Frameable t =>
Row t -> [([Char], [Char])]
fields (Row t -> [([Char], [Char])]) -> [Row t] -> [[([Char], [Char])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row t]
headRows) [[([Char], [Char])]]
-> [[([Char], [Char])]] -> [[([Char], [Char])]]
forall a. [a] -> [a] -> [a]
++ [[([Char], [Char])]]
spacerRow [[([Char], [Char])]]
-> [[([Char], [Char])]] -> [[([Char], [Char])]]
forall a. [a] -> [a] -> [a]
++ (Row t -> [([Char], [Char])]
forall (t :: (* -> *) -> *).
Frameable t =>
Row t -> [([Char], [Char])]
fields (Row t -> [([Char], [Char])]) -> [Row t] -> [[([Char], [Char])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row t]
tailRows)

        ([([Char], Int)]
headerLengths :: [(String, Int)]) = ((([Char], [Char]) -> ([Char], Int))
-> [([Char], [Char])] -> [([Char], Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
k, [Char]
_) -> ([Char]
k, [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Char]
k)) (Row t -> [([Char], [Char])]
forall (t :: (* -> *) -> *).
Frameable t =>
Row t -> [([Char], [Char])]
fields Row t
firstRow)) 
        ([([Char], Int)]
colWidths :: [(String, Int)]) 
            = (([Char], Max Int) -> ([Char], Int))
-> [([Char], Max Int)] -> [([Char], Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Max Int -> Int) -> ([Char], Max Int) -> ([Char], Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Max Int -> Int
forall a. Max a -> a
getMax) 
            ([([Char], Max Int)] -> [([Char], Int)])
-> [([Char], Max Int)] -> [([Char], Int)]
forall a b. (a -> b) -> a -> b
$ ([([Char], Max Int)] -> [([Char], [Char])] -> [([Char], Max Int)])
-> [([Char], Max Int)]
-> [[([Char], [Char])]]
-> [([Char], Max Int)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' 
                (\[([Char], Max Int)]
acc [([Char], [Char])]
mp -> (([Char], Max Int) -> ([Char], Max Int) -> ([Char], Max Int))
-> [([Char], Max Int)]
-> [([Char], Max Int)]
-> [([Char], Max Int)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\([Char]
k1, Max Int
v1) ([Char]
k2, Max Int
v2) -> ((Bool -> [Char] -> [Char]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([Char]
k1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
k2) [Char]
k1, Max Int
v1 Max Int -> Max Int -> Max Int
forall a. Semigroup a => a -> a -> a
<> Max Int
v2))) [([Char], Max Int)]
acc ((([Char], [Char]) -> ([Char], Max Int))
-> [([Char], [Char])] -> [([Char], Max Int)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> Max Int) -> ([Char], [Char]) -> ([Char], Max Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Max Int
forall a. a -> Max a
Max (Int -> Max Int) -> ([Char] -> Int) -> [Char] -> Max Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length)) [([Char], [Char])]
mp)) 
                ((([Char], Int) -> ([Char], Max Int))
-> [([Char], Int)] -> [([Char], Max Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Max Int) -> ([Char], Int) -> ([Char], Max Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Int -> Max Int
forall a. a -> Max a
Max) [([Char], Int)]
headerLengths) 
                [[([Char], [Char])]]
rows

        -- | Format a grid represented by a list of rows, where every row is a list of items
        -- All columns will have a fixed width
        formatGrid :: [ [(String, String)]] -- List of rows
                   -> String
        formatGrid :: [[([Char], [Char])]] -> [Char]
formatGrid [[([Char], [Char])]]
rs = [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
List.intersperse [Char]
"\n"
                                  ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
List.intersperse [Char]
" | " [ (Int -> [Char] -> [Char]
pad Int
w [Char]
k) | ([Char]
k, Int
w) <- [([Char], Int)]
colWidths]]
                                 [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
List.intersperse [Char]
" | " [ (Int -> [Char] -> [Char]
pad Int
w (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
'-')) | ([Char]
_, Int
w) <- [([Char], Int)]
colWidths]]
                                 [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
List.intersperse [Char]
" | " [ (Int -> [Char] -> [Char]
pad Int
w [Char]
v)
                                                                       | (([Char]
_, [Char]
v), ([Char]
_, Int
w)) <- [([Char], [Char])]
-> [([Char], Int)] -> [(([Char], [Char]), ([Char], Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [([Char], [Char])]
mp [([Char], Int)]
colWidths
                                                                       ]
                                    | [([Char], [Char])]
mp <- [[([Char], [Char])]]
rs
                                    ]
            where
                -- | Pad a string to a minimum of @n@ characters wide.
                pad :: Int -> String -> String 
                pad :: Int -> [Char] -> [Char]
pad Int
minNumChars [Char]
s
                    | Int
minNumChars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Char]
s = [Char]
s
                    | Bool
otherwise     = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
minNumChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Char]
s) Char
' ' [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
s