{-# LANGUAGE AllowAmbiguousTypes,
             ConstraintKinds,
             CPP,
             DataKinds,
             FlexibleContexts,
             FlexibleInstances,
             GADTs,
             KindSignatures,
             MultiParamTypeClasses,
             PatternSynonyms,
             PolyKinds,
             RankNTypes,
             ScopedTypeVariables,
             TypeApplications,
             TypeFamilies,
             TypeOperators,
             ViewPatterns #-}
module Frames.RecF (V.rappend, V.rtraverse, rdel, CanDelete,
                    -- frameCons, frameConsA, frameSnoc,
                    -- pattern (:&), pattern Nil,
                    AllCols,
                    UnColumn, -- AsVinyl(..)
                    StripFieldNames(..),
                    mapMono,
                    -- mapMethod,
                    -- runcurry, runcurry', runcurryA, runcurryA',
                    -- ShowRec,
                    -- showRec,
                    ColFun, ColumnHeaders,
                    columnHeaders) where
-- import Data.List (intercalate)
import Data.Kind (Type)
import Data.Proxy
import qualified Data.Vinyl as V
import Data.Vinyl (Rec(..))
import Data.Vinyl.Derived (StripFieldNames(..), Unlabeled)
import Data.Vinyl.Functor ((:.))
import Data.Vinyl.TypeLevel
import Frames.Col
import Frames.TypeLevel
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)

-- -- | Add a column to the head of a row.
-- frameCons :: (Functor f, KnownSymbol s)
--           => f a -> Rec f rs -> Rec f (s :-> a ': rs)
-- frameCons = (V.:&) . fmap Col
-- {-# INLINE frameCons #-}

-- -- | Add a pure column to the head of a row.
-- frameConsA :: (Applicative f, KnownSymbol s)
--            => a -> Rec f rs -> Rec f (s :-> a ': rs)
-- frameConsA = (V.:&) . fmap Col . pure
-- {-# INLINE frameConsA #-}

-- -- | Separate the first element of a row from the rest of the row.
-- frameUncons :: Functor f => Rec f (s :-> r ': rs) -> (f r, Rec f rs)
-- frameUncons (x V.:& xs) = (fmap getCol x, xs)
-- {-# INLINE frameUncons #-}

-- -- | Add a column to the tail of a row. Note that the supplied value
-- -- should be a 'Col' to work with the @Frames@ tooling.
-- frameSnoc :: Rec f rs -> f r -> Rec f (rs ++ '[r])
-- frameSnoc r x = V.rappend r (x V.:& RNil)
-- {-# INLINE frameSnoc #-}

-- pattern Nil :: Rec f '[]
-- pattern Nil <- RNil where
--   Nil = RNil

-- pattern (:&) :: (Functor f, KnownSymbol s) => f r -> Rec f rs -> Rec f (s :-> r ': rs)
-- pattern x :& xs <- (frameUncons -> (x, xs)) where
--   x :& xs = frameCons x xs

class ColumnHeaders (cs::[(Symbol, Type)]) where
  -- | Return the column names for a record.
  columnHeaders :: proxy (Rec f cs) -> [String]

instance ColumnHeaders '[] where
  columnHeaders :: forall (proxy :: * -> *) (f :: (Symbol, *) -> *).
proxy (Rec f '[]) -> [String]
columnHeaders proxy (Rec f '[])
_ = []

instance forall cs s c. (ColumnHeaders cs, KnownSymbol s)
    => ColumnHeaders (s :-> c ': cs) where
  columnHeaders :: forall (proxy :: * -> *) (f :: (Symbol, *) -> *).
proxy (Rec f ((s :-> c) : cs)) -> [String]
columnHeaders proxy (Rec f ((s :-> c) : cs))
_ = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy::Proxy s) forall a. a -> [a] -> [a]
: forall (cs :: [(Symbol, *)]) (proxy :: * -> *)
       (f :: (Symbol, *) -> *).
ColumnHeaders cs =>
proxy (Rec f cs) -> [String]
columnHeaders (forall {k} (t :: k). Proxy t
Proxy::Proxy (Rec f cs))

-- | A type function to convert a 'Rec f' to a 'Rec (g :. f)'. @ColFun
-- f (Record rs) = Rec (f :. ElField) rs@.
type family ColFun f x where
  ColFun f (Rec g rs) = Rec (f :. g) rs

-- | Strip the column information from each element of a list of
-- types.
type family UnColumn (ts :: [(Symbol, Type)]) where
  UnColumn '[] = '[]
  UnColumn ((s :-> t) ': ts) = t ': UnColumn ts

-- | Enforce a constraint on the payload type of each column.
type AllCols c ts = AllConstrained c (UnColumn ts)

-- | Map a function across a 'Rec' with monomorphic (i.e. all the
-- same) indices.
mapMonoV :: (AllAre a ts, Functor f)
         => (a -> b)
         -> Rec f ts
         -> Rec f (ReplaceAll b ts)
mapMonoV :: forall a (ts :: [*]) (f :: * -> *) b.
(AllAre a ts, Functor f) =>
(a -> b) -> Rec f ts -> Rec f (ReplaceAll b ts)
mapMonoV a -> b
_ Rec f ts
RNil = forall {u} (a :: u -> *). Rec a '[]
RNil
mapMonoV a -> b
f (f r
x :& Rec f rs
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f r
x forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a (ts :: [*]) (f :: * -> *) b.
(AllAre a ts, Functor f) =>
(a -> b) -> Rec f ts -> Rec f (ReplaceAll b ts)
mapMonoV a -> b
f Rec f rs
xs

-- | Map a function across a homogeneous 'Rec' of named values. This
-- is a thin wrapper over 'mapMonoV'.
mapMono :: (AllAre a (Unlabeled ts),
            StripFieldNames ts,
            StripFieldNames (ReplaceAllSnd b ts),
            ReplaceAll b (Unlabeled ts) ~ Unlabeled (ReplaceAllSnd b ts))
        => (a -> b)
        -> Rec V.ElField ts
        -> Rec V.ElField (ReplaceAllSnd b ts)
mapMono :: forall a (ts :: [(Symbol, *)]) b.
(AllAre a (Unlabeled ts), StripFieldNames ts,
 StripFieldNames (ReplaceAllSnd b ts),
 ReplaceAll b (Unlabeled ts) ~ Unlabeled (ReplaceAllSnd b ts)) =>
(a -> b) -> Rec ElField ts -> Rec ElField (ReplaceAllSnd b ts)
mapMono a -> b
f = forall (ts :: [(Symbol, *)]).
StripFieldNames ts =>
Rec Identity (Unlabeled ts) -> Rec ElField ts
withNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ts :: [*]) (f :: * -> *) b.
(AllAre a ts, Functor f) =>
(a -> b) -> Rec f ts -> Rec f (ReplaceAll b ts)
mapMonoV a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [(Symbol, *)]).
StripFieldNames ts =>
Rec ElField ts -> Rec Identity (Unlabeled ts)
stripNames

-- | A constraint that a field can be deleted from a record.
type CanDelete r rs = (V.RElem r rs (RIndex r rs), RDelete r rs V.⊆ rs)

-- | Delete a field from a record
rdel :: CanDelete r rs => Rec f rs -> Rec f (RDelete r rs)
rdel :: forall {a} (r :: a) (rs :: [a]) (f :: a -> *).
CanDelete r rs =>
Rec f rs -> Rec f (RDelete r rs)
rdel = 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