{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ConstraintKinds,
             DataKinds,
             EmptyCase,
             FlexibleContexts,
             FlexibleInstances,
             FunctionalDependencies,
             KindSignatures,
             GADTs,
             MultiParamTypeClasses,
             PatternSynonyms,
             PolyKinds,
             ScopedTypeVariables,
             TypeFamilies,
             TypeOperators,
             UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Frames.Rec where
import Data.Vinyl hiding (rget)
import qualified Data.Vinyl as V
import Data.Vinyl.Functor (Const(..), Compose(..), (:.))
import Data.Vinyl.Class.Method (PayloadType)
import Frames.Col
import GHC.TypeLits (KnownSymbol)

-- | A record with unadorned values. This is @Vinyl@'s 'Rec'
-- 'ElField'. We give this type a name as it is used pervasively for
-- records in 'Frames'.
type Record = FieldRec

-- | A @cons@ function for building 'Record' values.
(&:) :: KnownSymbol s => a -> Record rs -> Record (s :-> a ': rs)
a
x &: :: forall (s :: Symbol) a (rs :: [(Symbol, *)]).
KnownSymbol s =>
a -> Record rs -> Record ((s :-> a) : rs)
&: Record rs
xs = forall (t :: (Symbol, *)). Snd t -> ElField t
Field a
x forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Record rs
xs
infixr 5 &:

type family RecordColumns t where
  RecordColumns (Record ts) = ts

-- | Separate the first element of a 'Record' from the rest of the row.
recUncons :: Record (s :-> a ': rs) -> (a, Record rs)
recUncons :: forall (s :: Symbol) a (rs :: [(Symbol, *)]).
Record ((s :-> a) : rs) -> (a, Record rs)
recUncons (Field Snd r
x :& Rec ElField rs
xs) = (Snd r
x, Rec ElField rs
xs)
-- recUncons x = case x of _ -> error "recUncons impossible case"

-- | Undistribute 'Maybe' from a 'Rec' 'Maybe'. This is just a
-- specific usage of 'rtraverse', but it is quite common.
recMaybe :: Rec (Maybe :. ElField) cs -> Maybe (Record cs)
recMaybe :: forall (cs :: [(Symbol, *)]).
Rec (Maybe :. ElField) cs -> Maybe (Record cs)
recMaybe = forall {u} (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose
{-# INLINE recMaybe #-}

-- | Show each field of a 'Record' /without/ its column name.
showFields :: (RecMapMethod Show ElField ts, RecordToList ts)
           => Record ts -> [String]
showFields :: forall (ts :: [(Symbol, *)]).
(RecMapMethod Show ElField ts, RecordToList ts) =>
Record ts -> [String]
showFields = forall {u} (rs :: [u]) a.
RecordToList rs =>
Rec (Const a) rs -> [a]
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
rmapMethod @Show forall (a :: (Symbol, *)).
Show (PayloadType ElField a) =>
ElField a -> Const String a
aux
  where aux :: (Show (PayloadType ElField a)) => ElField a -> Const String a
        aux :: forall (a :: (Symbol, *)).
Show (PayloadType ElField a) =>
ElField a -> Const String a
aux (Field Snd a
x) = forall k a (b :: k). a -> Const a b
Const (forall a. Show a => a -> String
show Snd a
x)
{-# INLINABLE showFields #-}

-- | Get the value of a field of a 'Record'. This is intended for use
-- with @TypeApplications@, as compared to 'rgetv' that is intended
-- for use with @OverloadedLabels@.
rgetField :: forall t s a rs. (t ~ '(s,a), t ∈ rs) => Record rs -> a
rgetField :: forall (t :: (Symbol, *)) (s :: Symbol) a (rs :: [(Symbol, *)]).
(t ~ '(s, a), t ∈ rs) =>
Record rs -> a
rgetField = forall (s :: Symbol) t. ElField '(s, t) -> t
getField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (rs :: [k]) (f :: k -> *)
       (record :: (k -> *) -> [k] -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
record f rs -> f r
V.rget @t
{-# INLINE rgetField #-}

-- | Replace the value of a field of a 'Record'. This is intended for
-- use with @TypeApplications@, as compared to 'rputf' that is
-- intended for use with @OverloadedLabels@.
rputField :: forall t s a rs. (t ~ '(s,a), t ∈ rs, KnownSymbol s)
          => a -> Record rs -> Record rs
rputField :: forall (t :: (Symbol, *)) (s :: Symbol) a (rs :: [(Symbol, *)]).
(t ~ '(s, a), t ∈ rs, KnownSymbol s) =>
a -> Record rs -> Record rs
rputField = forall k (r :: k) (rs :: [k]) (record :: (k -> *) -> [k] -> *)
       (f :: k -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
f r -> record f rs -> record f rs
V.rput @_ @t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (Symbol, *)). Snd t -> ElField t
Field
{-# INLINE rputField #-}