{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds, FlexibleContexts, GADTs, ScopedTypeVariables,
             TemplateHaskell, TypeOperators #-}

-- | Functions useful for interactively exploring and experimenting
-- with a data set.
module Frames.Exploration (pipePreview, select, lenses, recToList,
                           pr, pr1, showFrame, printFrame,
                           takeRows, dropRows) where
import Data.Char (isSpace, isUpper)
import qualified Data.Foldable as F
import Data.Kind (Type)
import Data.List (intercalate)
import Data.Proxy
import qualified Data.Vinyl as V
import qualified Data.Vinyl.Class.Method as V
import Data.Vinyl.Functor (ElField(Field), Const(..))
import Frames.Rec
import GHC.TypeLits (Symbol)
import Language.Haskell.TH hiding (Type)
import Language.Haskell.TH.Quote
import Pipes hiding (Proxy)
import qualified Pipes as P
import qualified Pipes.Prelude as P
import Pipes.Safe (SafeT, runSafeT, MonadMask)
import Frames.Frame (Frame(Frame))
import Frames.RecF (columnHeaders, ColumnHeaders)

-- * Preview Results

-- | @preview src n f@ prints out the first @n@ results of piping
-- @src@ through @f@.
pipePreview :: (Show b, MonadIO m, MonadMask m)
            => Producer a (SafeT m) () -> Int -> Pipe a b (SafeT m) () -> m ()
pipePreview :: forall b (m :: * -> *) a.
(Show b, MonadIO m, MonadMask m) =>
Producer a (SafeT m) () -> Int -> Pipe a b (SafeT m) () -> m ()
pipePreview Producer a (SafeT m) ()
src Int
n Pipe a b (SafeT m) ()
f = forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect forall a b. (a -> b) -> a -> b
$ Producer a (SafeT m) ()
src forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Pipe a b (SafeT m) ()
f forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) a. Functor m => Int -> Pipe a a m ()
P.take Int
n forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) a r. (MonadIO m, Show a) => Consumer' a m r
P.print

-- * Column Selection

-- | @select (Proxy::Proxy [A,B,C])@ extracts columns @A@, @B@, and
-- @C@, from a larger record. Note, this is just a way of pinning down
-- the type of a usage of 'V.rcast'.
select :: (fs V.⊆ rs) => proxy fs -> Record rs -> Record fs
select :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
       (proxy :: [(Symbol, *)] -> *).
(fs ⊆ rs) =>
proxy fs -> Record rs -> Record fs
select proxy fs
_ = forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
       (record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
V.rcast

-- | @lenses (Proxy::Proxy [A,B,C])@ provides a lens onto columns @A@,
-- @B@, and @C@. This is just a way of pinning down the type of
-- 'V.rsubset'.
lenses :: (fs V.⊆ rs, Functor f)
       => proxy fs -> (Record fs -> f (Record fs)) -> Record rs -> f (Record rs)
lenses :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)]) (f :: * -> *)
       (proxy :: [(Symbol, *)] -> *).
(fs ⊆ rs, Functor f) =>
proxy fs
-> (Record fs -> f (Record fs)) -> Record rs -> f (Record rs)
lenses proxy fs
_ = forall {k1} k2 (rs :: [k2]) (ss :: [k2]) (f :: k1 -> *)
       (g :: * -> *) (record :: (k1 -> *) -> [k2] -> *) (is :: [Nat]).
(RecSubset record rs ss is, Functor g, RecSubsetFCtx record f) =>
(record f rs -> g (record f rs)) -> record f ss -> g (record f ss)
V.rsubset

{-# DEPRECATED select "Use Data.Vinyl.rcast with a type application. " #-}
{-# DEPRECATED lenses "Use Data.Vinyl.rsubset with a type application." #-}

-- * Proxy Syntax

-- | A proxy value quasiquoter; a way of passing types as
-- values. @[pr|T|]@ will splice an expression @Proxy::Proxy T@, while
-- @[pr|A,B,C|]@ will splice in a value of @Proxy :: Proxy
-- [A,B,C]@. If we have a record type with @Name@ and @Age@ among
-- other fields, we can write @select @[pr|Name,Age|]@ for a function
-- that extracts those fields from a larger record.
pr :: QuasiQuoter
pr :: QuasiQuoter
pr = (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter forall {m :: * -> *}. Quote m => String -> m Exp
mkProxy forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined
  where mkProxy :: String -> m Exp
mkProxy String
s = let ts :: [String]
ts = forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
',' String
s
                        cons :: m [Type]
cons = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). Quote m => Name -> m Type
conT forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName) [String]
ts
                        mkList :: [Type] -> Type
mkList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Type -> Type
AppT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Type
AppT Type
PromotedConsT) Type
PromotedNilT
                    in case [String]
ts of
                         [h :: String
h@(Char
t:String
_)]
                             | Char -> Bool
isUpper Char
t -> [|Proxy::Proxy $(fmap head cons)|]
                             | Bool
otherwise -> [|Proxy::Proxy $(varT $ mkName h)|]
                         [String]
_ -> [|Proxy::Proxy $(fmap mkList cons)|]

-- | Like 'pr', but takes a single type, which is used to produce a
-- 'Proxy' for a single-element list containing only that type. This
-- is useful for passing a single type to a function that wants a list
-- of types.
pr1 :: QuasiQuoter
pr1 :: QuasiQuoter
pr1 = (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter forall {m :: * -> *}. Quote m => String -> m Exp
mkProxy forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined
  where mkProxy :: String -> m Exp
mkProxy String
s = let sing :: Type -> Type
sing Type
x = Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
PromotedConsT Type
x) Type
PromotedNilT
                    in case String
s of
                         Char
t:String
_
                           | Char -> Bool
isUpper Char
t ->
                             [|Proxy::Proxy $(fmap sing (conT (mkName s)))|]
                           | Bool
otherwise ->
                             [|Proxy::Proxy $(fmap sing (varT $ mkName s))|]
                         String
_ -> forall a. HasCallStack => String -> a
error String
"Empty string passed to pr1"

-- * ToList

recToList :: forall a (rs :: [(Symbol, Type)]).
             (V.RecMapMethod ((~) a) ElField rs, V.RecordToList rs)
          => Record rs -> [a]
recToList :: forall a (rs :: [(Symbol, *)]).
(RecMapMethod ((~) a) ElField rs, RecordToList rs) =>
Record rs -> [a]
recToList = forall {u} (rs :: [u]) a.
RecordToList rs =>
Rec (Const a) rs -> [a]
V.recordToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (c :: * -> Constraint) (f :: u -> *) (ts :: [u])
       (g :: u -> *).
RecMapMethod c f ts =>
(forall (a :: u). c (PayloadType f a) => f a -> g a)
-> Rec f ts -> Rec g ts
V.rmapMethod @((~) a) forall (t :: (Symbol, *)).
(a ~ PayloadType ElField t) =>
ElField t -> Const a t
aux
  where aux :: a ~ V.PayloadType ElField t  => V.ElField t -> Const a t
        aux :: forall (t :: (Symbol, *)).
(a ~ PayloadType ElField t) =>
ElField t -> Const a t
aux (Field Snd t
x) = forall k a (b :: k). a -> Const a b
Const Snd t
x

-- * Helpers

-- | Split on a delimiter.
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn :: forall a. Eq a => a -> [a] -> [[a]]
splitOn a
d = [a] -> [[a]]
go
  where go :: [a] -> [[a]]
go [] = []
        go [a]
xs = let ([a]
h,[a]
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
d) [a]
xs
                in case [a]
t of
                     [] -> [[a]
h]
                     (a
_:[a]
t') -> [a]
h forall a. a -> [a] -> [a]
: [a] -> [[a]]
go [a]
t'

-- | Remove white space from both ends of a 'String'.
strip :: String -> String
strip :: String -> String
strip = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | @takeRows n frame@ produces a new 'Frame' made up of the first
-- @n@ rows of @frame@.
takeRows :: Int -> Frame (Record rs) -> Frame (Record rs)
takeRows :: forall (rs :: [(Symbol, *)]).
Int -> Frame (Record rs) -> Frame (Record rs)
takeRows Int
n (Frame Int
len Int -> Record rs
rows) = forall r. Int -> (Int -> r) -> Frame r
Frame (forall a. Ord a => a -> a -> a
min Int
n Int
len) Int -> Record rs
rows

-- | @dropRows n frame@ produces a new 'Frame' just like @frame@, but
-- not including its first @n@ rows.
dropRows :: Int -> Frame (Record rs) -> Frame (Record rs)
dropRows :: forall (rs :: [(Symbol, *)]).
Int -> Frame (Record rs) -> Frame (Record rs)
dropRows Int
n (Frame Int
len Int -> Record rs
rows) = forall r. Int -> (Int -> r) -> Frame r
Frame (forall a. Ord a => a -> a -> a
max Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
n)) (\Int
i -> Int -> Record rs
rows (Int
i forall a. Num a => a -> a -> a
+ Int
n))

-- | Format a 'Frame' to a 'String'.
showFrame :: forall rs.
  (ColumnHeaders rs, V.RecMapMethod Show ElField rs, V.RecordToList rs)
  => String -- ^ Separator between fields
  -> Frame (Record rs) -- ^ The 'Frame' to be formatted to a 'String'
  -> String
showFrame :: forall (rs :: [(Symbol, *)]).
(ColumnHeaders rs, RecMapMethod Show ElField rs,
 RecordToList rs) =>
String -> Frame (Record rs) -> String
showFrame String
sep Frame (Record rs)
frame =
  [String] -> String
unlines (forall a. [a] -> [[a]] -> [a]
intercalate String
sep (forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
       (f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Record rs))) forall a. a -> [a] -> [a]
: [String]
rows)
  where rows :: [String]
rows = forall a. Producer a Identity () -> [a]
P.toList (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [(Symbol, *)]).
(RecMapMethod Show ElField ts, RecordToList ts) =>
Record ts -> [String]
showFields) Frame (Record rs)
frame)

-- | Print a 'Frame' to 'System.IO.stdout'.
printFrame :: forall rs.
  (ColumnHeaders rs, V.RecMapMethod Show ElField rs, V.RecordToList rs)
  => String -- ^ Separator between fields
  -> Frame (Record rs) -- ^ The 'Frame' to be printed to @stdout@
  -> IO ()
printFrame :: forall (rs :: [(Symbol, *)]).
(ColumnHeaders rs, RecMapMethod Show ElField rs,
 RecordToList rs) =>
String -> Frame (Record rs) -> IO ()
printFrame String
sep Frame (Record rs)
frame = do
  String -> IO ()
putStrLn (forall a. [a] -> [[a]] -> [a]
intercalate String
sep (forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
       (f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Record rs))))
  forall (m :: * -> *) r. Monad m => Effect m r -> m r
P.runEffect (Proxy X () () String IO ()
rows forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *). MonadIO m => Consumer' String m ()
P.stdoutLn)
  where rows :: Proxy X () () String IO ()
rows = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [(Symbol, *)]).
(RecMapMethod Show ElField ts, RecordToList ts) =>
Record ts -> [String]
showFields) Frame (Record rs)
frame