{-# LANGUAGE ConstraintKinds, CPP, DataKinds, FlexibleContexts,
             FlexibleInstances, KindSignatures, MultiParamTypeClasses,
             PolyKinds, ScopedTypeVariables, TypeFamilies,
             TypeOperators, UndecidableInstances, TemplateHaskell,
             QuasiQuotes, Rank2Types, TypeApplications,
             AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Frames.ExtraInstances where

import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Discrimination.Grouping
import Data.Hashable
import Control.DeepSeq
import Frames.Col
import Frames.Rec
import Frames.Frame
import Frames.RecF (AllCols)
import Data.Vinyl.Functor as VF
import Data.Vinyl
import Data.Text (Text)

-- Grouping instances
instance (AllCols Grouping rs
         , Grouping (Record rs)
         , Grouping (ElField (s :-> r))
         , Grouping r
         ) =>
         Grouping (Record ((s :-> r) : rs)) where
  grouping :: Group (Record ((s :-> r) : rs))
grouping = (Record ((s :-> r) : rs) -> (r, Record rs))
-> Group r -> Group (Record rs) -> Group (Record ((s :-> r) : rs))
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide Record ((s :-> r) : rs) -> (r, Record rs)
forall (s :: Symbol) a (rs :: [(Symbol, *)]).
Record ((s :-> a) : rs) -> (a, Record rs)
recUncons Group r
forall a. Grouping a => Group a
grouping Group (Record rs)
forall a. Grouping a => Group a
grouping

instance Grouping (Record '[]) where
  grouping :: Group (Record '[])
grouping = Group (Record '[])
forall (f :: * -> *) a. Divisible f => f a
conquer

instance (Grouping a) => Grouping (ElField (s :-> a)) where
   grouping :: Group (ElField (s :-> a))
grouping = (ElField (s :-> a) -> a) -> Group a -> Group (ElField (s :-> a))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ElField (s :-> a) -> a
forall (s :: Symbol) t. ElField '(s, t) -> t
getCol Group a
forall a. Grouping a => Group a
grouping

instance Grouping Text where
  grouping :: Group Text
grouping = (Text -> Int) -> Group Int -> Group Text
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Text -> Int
forall a. Hashable a => a -> Int
hash Group Int
forall a. Grouping a => Group a
grouping


-- NFData* instances
#if MIN_VERSION_deepseq(1,4,3)
instance (NFData a) =>
         NFData (VF.Identity a) where
  rnf :: Identity a -> ()
rnf = Identity a -> ()
forall (f :: * -> *) a. (NFData1 f, NFData a) => f a -> ()
rnf1

instance NFData1 VF.Identity where
  liftRnf :: (a -> ()) -> Identity a -> ()
liftRnf a -> ()
r = a -> ()
r (a -> ()) -> (Identity a -> a) -> Identity a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
getIdentity

#if MIN_VERSION_vinyl(0,13,1)
#else
instance (NFData (f r), NFData (Rec f rs)) => NFData (Rec f (r ': rs)) where
  rnf (x :& xs) = rnf x `seq` rnf xs
#endif

instance NFData (Rec f '[]) where
  rnf :: Rec f '[] -> ()
rnf Rec f '[]
RNil = ()

instance (NFData1 f, NFData1 g) => NFData1 (Compose f g) where
  liftRnf :: (a -> ()) -> Compose f g a -> ()
liftRnf a -> ()
f = (g a -> ()) -> f (g a) -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf ((a -> ()) -> g a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f) (f (g a) -> ())
-> (Compose f g a -> f (g a)) -> Compose f g a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose

instance NFData (f (g a)) => NFData (Compose f g a) where
  rnf :: Compose f g a -> ()
rnf (Compose f (g a)
x) = f (g a) -> ()
forall a. NFData a => a -> ()
rnf f (g a)
x

#endif


instance (NFData a) =>
         NFData (Frame a) where
  rnf :: Frame a -> ()
rnf = (a -> () -> ()) -> () -> Frame a -> ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x ()
acc -> a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` ()
acc) ()

instance (NFData a) => NFData (ElField (s :-> a)) where
  rnf :: ElField (s :-> a) -> ()
rnf = a -> ()
forall a. NFData a => a -> ()
rnf (a -> ()) -> (ElField (s :-> a) -> a) -> ElField (s :-> a) -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElField (s :-> a) -> a
forall (s :: Symbol) t. ElField '(s, t) -> t
getCol