{-# 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.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
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 :: 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 = SafeT m () -> m ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT m () -> m ())
-> (Effect (SafeT m) () -> SafeT m ())
-> Effect (SafeT m) ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect (SafeT m) () -> SafeT m ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (SafeT m) () -> m ()) -> Effect (SafeT m) () -> m ()
forall a b. (a -> b) -> a -> b
$ Producer a (SafeT m) ()
src Producer a (SafeT m) ()
-> Pipe a b (SafeT m) () -> Proxy X () () b (SafeT m) ()
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 Proxy X () () b (SafeT m) ()
-> Proxy () b () b (SafeT m) () -> Proxy X () () b (SafeT m) ()
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
>-> Int -> Proxy () b () b (SafeT m) ()
forall (m :: * -> *) a. Functor m => Int -> Pipe a a m ()
P.take Int
n Proxy X () () b (SafeT m) ()
-> Proxy () b () X (SafeT m) () -> Effect (SafeT m) ()
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
>-> Proxy () b () X (SafeT m) ()
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 :: proxy fs -> Record rs -> Record fs
select proxy fs
_ = Record rs -> Record 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 :: proxy fs
-> (Record fs -> f (Record fs)) -> Record rs -> f (Record rs)
lenses proxy fs
_ = (Record fs -> f (Record fs)) -> Record rs -> f (Record rs)
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 String -> Q Exp
mkProxy String -> Q Pat
forall a. HasCallStack => a
undefined String -> Q Type
forall a. HasCallStack => a
undefined String -> Q [Dec]
forall a. HasCallStack => a
undefined
  where mkProxy :: String -> Q Exp
mkProxy String
s = let ts :: [String]
ts = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
',' String
s
                        cons :: Q [Type]
cons = (String -> Q Type) -> [String] -> Q [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name -> Q Type
conT (Name -> Q Type) -> (String -> Name) -> String -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName) [String]
ts
                        mkList :: [Type] -> Type
mkList = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Type -> Type
AppT (Type -> Type -> Type) -> (Type -> Type) -> Type -> Type -> Type
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 String -> Q Exp
mkProxy String -> Q Pat
forall a. HasCallStack => a
undefined String -> Q Type
forall a. HasCallStack => a
undefined String -> Q [Dec]
forall a. HasCallStack => a
undefined
  where mkProxy :: String -> Q 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
_ -> String -> Q Exp
forall a. HasCallStack => String -> a
error String
"Empty string passed to pr1"

-- * ToList

recToList :: forall a (rs :: [(Symbol,*)]).
             (V.RecMapMethod ((~) a) ElField rs, V.RecordToList rs)
          => Record rs -> [a]
recToList :: Record rs -> [a]
recToList = Rec (Const a) rs -> [a]
forall u (rs :: [u]) a. RecordToList rs => Rec (Const a) rs -> [a]
V.recordToList (Rec (Const a) rs -> [a])
-> (Record rs -> Rec (Const a) rs) -> Record rs -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: (Symbol, *)).
 (a ~ PayloadType ElField a) =>
 ElField a -> Const a a)
-> Record rs -> Rec (Const a) rs
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 (a :: (Symbol, *)).
(a ~ PayloadType ElField a) =>
ElField a -> Const a a
aux
  where aux :: a ~ V.PayloadType ElField t  => V.ElField t -> Const a t
        aux :: ElField t -> Const a t
aux (Field t
x) = t -> Const t t
forall k a (b :: k). a -> Const a b
Const t
x

-- * Helpers

-- | Split on a delimiter.
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn :: a -> [a] -> [[a]]
splitOn a
d = [a] -> [[a]]
go
  where go :: [a] -> [[a]]
go [] = []
        go [a]
xs = let ([a]
h,[a]
t) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d) [a]
xs
                in case [a]
t of
                     [] -> [[a]
h]
                     (a
_:[a]
t') -> [a]
h [a] -> [[a]] -> [[a]]
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 = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
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 :: Int -> Frame (Record rs) -> Frame (Record rs)
takeRows Int
n (Frame Int
len Int -> Record rs
rows) = Int -> (Int -> Record rs) -> Frame (Record rs)
forall r. Int -> (Int -> r) -> Frame r
Frame (Int -> Int -> Int
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 :: Int -> Frame (Record rs) -> Frame (Record rs)
dropRows Int
n (Frame Int
len Int -> Record rs
rows) = Int -> (Int -> Record rs) -> Frame (Record rs)
forall r. Int -> (Int -> r) -> Frame r
Frame (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)) (\Int
i -> Int -> Record rs
rows (Int
i Int -> Int -> Int
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 :: String -> Frame (Record rs) -> String
showFrame String
sep Frame (Record rs)
frame =
  [String] -> String
unlines (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
sep (Proxy (Record rs) -> [String]
forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
       (f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (Proxy (Record rs)
forall k (t :: k). Proxy t
Proxy :: Proxy (Record rs))) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rows)
  where rows :: [String]
rows = Producer String Identity () -> [String]
forall a. Producer a Identity () -> [a]
P.toList ((Record rs -> Producer String Identity ())
-> Frame (Record rs) -> Producer String Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ (String -> Producer String Identity ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield (String -> Producer String Identity ())
-> (Record rs -> String)
-> Record rs
-> Producer String Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
sep ([String] -> String)
-> (Record rs -> [String]) -> Record rs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record rs -> [String]
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 :: String -> Frame (Record rs) -> IO ()
printFrame String
sep Frame (Record rs)
frame = do
  String -> IO ()
putStrLn (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
sep (Proxy (Record rs) -> [String]
forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
       (f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (Proxy (Record rs)
forall k (t :: k). Proxy t
Proxy :: Proxy (Record rs))))
  Effect IO () -> IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
P.runEffect (Proxy X () () String IO ()
rows Proxy X () () String IO ()
-> Proxy () String () X IO () -> Effect IO ()
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
>-> Proxy () String () X IO ()
forall (m :: * -> *). MonadIO m => Consumer' String m ()
P.stdoutLn)
  where rows :: Proxy X () () String IO ()
rows = (Record rs -> Proxy X () () String IO ())
-> Frame (Record rs) -> Proxy X () () String IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ (String -> Proxy X () () String IO ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield (String -> Proxy X () () String IO ())
-> (Record rs -> String) -> Record rs -> Proxy X () () String IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
sep ([String] -> String)
-> (Record rs -> [String]) -> Record rs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record rs -> [String]
forall (ts :: [(Symbol, *)]).
(RecMapMethod Show ElField ts, RecordToList ts) =>
Record ts -> [String]
showFields) Frame (Record rs)
frame