{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}

module Galley.Cassandra.GetAllTeamFeatures (getAllDbFeatures) where

import Cassandra
import Data.Id
import Galley.Cassandra.Instances ()
import Galley.Cassandra.MakeFeature
import Galley.Cassandra.Orphans ()
import Generics.SOP
import Imports hiding (Map)
import Polysemy.Internal
import Wire.API.Team.Feature

type family ConcatFeatureRow xs where
  ConcatFeatureRow '[] = '[]
  ConcatFeatureRow (x : xs) = Append (FeatureRow x) (ConcatFeatureRow xs)

type AllFeatureRow = ConcatFeatureRow Features

emptyRow :: NP Maybe AllFeatureRow
emptyRow :: NP Maybe AllFeatureRow
emptyRow = (forall a. Maybe a)
-> NP
     Maybe
     '[FeatureStatus, FeatureStatus, FeatureStatus, FeatureStatus,
       FeatureStatus, FeatureStatus, FeatureStatus, EnforceAppLock, Int32,
       LockStatus, FeatureStatus, LockStatus, FeatureStatus, One2OneCalls,
       LockStatus, FeatureStatus, Int32, LockStatus, FeatureStatus,
       LockStatus, FeatureStatus, LockStatus, FeatureStatus, ProtocolTag,
       Set UserId, Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag,
       FeatureStatus, LockStatus, FeatureStatus, LockStatus,
       FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool, LockStatus,
       FeatureStatus, UTCTime, UTCTime, LockStatus, FeatureStatus, Text,
       FeatureStatus]
forall (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure Maybe a
forall a. Maybe a
Nothing

class ConcatFeatures cfgs where
  rowToAllFeatures :: NP Maybe (ConcatFeatureRow cfgs) -> NP DbFeature cfgs

instance ConcatFeatures '[] where
  rowToAllFeatures :: NP Maybe (ConcatFeatureRow '[]) -> NP DbFeature '[]
rowToAllFeatures NP Maybe (ConcatFeatureRow '[])
Nil = NP DbFeature '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance
  ( SplitNP (FeatureRow cfg) (ConcatFeatureRow cfgs),
    ConcatFeatures cfgs,
    MakeFeature cfg
  ) =>
  ConcatFeatures (cfg : cfgs)
  where
  rowToAllFeatures :: NP Maybe (ConcatFeatureRow (cfg : cfgs))
-> NP DbFeature (cfg : cfgs)
rowToAllFeatures NP Maybe (ConcatFeatureRow (cfg : cfgs))
row = case forall (xs :: [*]) (ys :: [*]) (f :: * -> *).
SplitNP xs ys =>
NP f (Append xs ys) -> (NP f xs, NP f ys)
forall {k} (xs :: [k]) (ys :: [k]) (f :: k -> *).
SplitNP xs ys =>
NP f (Append xs ys) -> (NP f xs, NP f ys)
splitNP @(FeatureRow cfg) @(ConcatFeatureRow cfgs) NP Maybe (Append (FeatureRow cfg) (ConcatFeatureRow cfgs))
NP Maybe (ConcatFeatureRow (cfg : cfgs))
row of
    (NP Maybe (FeatureRow cfg)
row0, NP Maybe (ConcatFeatureRow cfgs)
row1) -> NP Maybe (FeatureRow cfg) -> DbFeature cfg
forall cfg.
MakeFeature cfg =>
NP Maybe (FeatureRow cfg) -> DbFeature cfg
rowToFeature NP Maybe (FeatureRow cfg)
row0 DbFeature cfg -> NP DbFeature cfgs -> NP DbFeature (cfg : cfgs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe (ConcatFeatureRow cfgs) -> NP DbFeature cfgs
forall (cfgs :: [*]).
ConcatFeatures cfgs =>
NP Maybe (ConcatFeatureRow cfgs) -> NP DbFeature cfgs
rowToAllFeatures NP Maybe (ConcatFeatureRow cfgs)
row1

class SplitNP xs ys where
  splitNP :: NP f (Append xs ys) -> (NP f xs, NP f ys)

instance SplitNP '[] ys where
  splitNP :: forall (f :: k -> *). NP f (Append '[] ys) -> (NP f '[], NP f ys)
splitNP NP f (Append '[] ys)
ys = (NP f '[]
forall {k} (a :: k -> *). NP a '[]
Nil, NP f ys
NP f (Append '[] ys)
ys)

instance (SplitNP xs ys) => SplitNP (x ': xs) ys where
  splitNP :: forall (f :: k -> *).
NP f (Append (x : xs) ys) -> (NP f (x : xs), NP f ys)
splitNP (f x
z :* NP f xs
zs) = case NP f (Append xs ys) -> (NP f xs, NP f ys)
forall {k} (xs :: [k]) (ys :: [k]) (f :: k -> *).
SplitNP xs ys =>
NP f (Append xs ys) -> (NP f xs, NP f ys)
forall (f :: k -> *). NP f (Append xs ys) -> (NP f xs, NP f ys)
splitNP NP f xs
NP f (Append xs ys)
zs of
    (NP f xs
xs, NP f ys
ys) -> (f x
f x
z f x -> NP f xs -> NP f (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP f xs
xs, NP f ys
ys)

class AppendNP xs ys where
  appendNP :: NP f xs -> NP f ys -> NP f (Append xs ys)

instance AppendNP '[] ys where
  appendNP :: forall (f :: a -> *). NP f '[] -> NP f ys -> NP f (Append '[] ys)
appendNP NP f '[]
Nil NP f ys
ys = NP f ys
NP f (Append '[] ys)
ys

instance (AppendNP xs ys) => AppendNP (x : xs) ys where
  appendNP :: forall (f :: a -> *).
NP f (x : xs) -> NP f ys -> NP f (Append (x : xs) ys)
appendNP (f x
x :* NP f xs
xs) NP f ys
ys = f x
x f x -> NP f (Append xs ys) -> NP f (x : Append xs ys)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP f xs -> NP f ys -> NP f (Append xs ys)
forall {a} (xs :: [a]) (ys :: [a]) (f :: a -> *).
AppendNP xs ys =>
NP f xs -> NP f ys -> NP f (Append xs ys)
forall (f :: a -> *). NP f xs -> NP f ys -> NP f (Append xs ys)
appendNP NP f xs
xs NP f ys
ys

class ConcatColumns cfgs where
  concatColumns :: NP (K String) (ConcatFeatureRow cfgs)

instance ConcatColumns '[] where
  concatColumns :: NP (K String) (ConcatFeatureRow '[])
concatColumns = NP (K String) '[]
NP (K String) (ConcatFeatureRow '[])
forall {k} (a :: k -> *). NP a '[]
Nil

instance
  ( AppendNP (FeatureRow cfg) (ConcatFeatureRow cfgs),
    MakeFeature cfg,
    ConcatColumns cfgs
  ) =>
  ConcatColumns (cfg : cfgs)
  where
  concatColumns :: NP (K String) (ConcatFeatureRow (cfg : cfgs))
concatColumns = forall cfg. MakeFeature cfg => NP (K String) (FeatureRow cfg)
featureColumns @cfg NP (K String) (FeatureRow cfg)
-> NP (K String) (ConcatFeatureRow cfgs)
-> NP (K String) (Append (FeatureRow cfg) (ConcatFeatureRow cfgs))
forall {a} (xs :: [a]) (ys :: [a]) (f :: a -> *).
AppendNP xs ys =>
NP f xs -> NP f ys -> NP f (Append xs ys)
forall (f :: * -> *).
NP f (FeatureRow cfg)
-> NP f (ConcatFeatureRow cfgs)
-> NP f (Append (FeatureRow cfg) (ConcatFeatureRow cfgs))
`appendNP` forall (cfgs :: [*]).
ConcatColumns cfgs =>
NP (K String) (ConcatFeatureRow cfgs)
concatColumns @cfgs

getAllDbFeatures ::
  forall row mrow m.
  ( MonadClient m,
    row ~ AllFeatureRow,
    Tuple (TupleP mrow),
    IsProductType (TupleP mrow) mrow,
    AllZip (IsF Maybe) row mrow
  ) =>
  TeamId ->
  m (AllFeatures DbFeature)
getAllDbFeatures :: forall (row :: [*]) (mrow :: [*]) (m :: * -> *).
(MonadClient m, row ~ AllFeatureRow, Tuple (TupleP mrow),
 IsProductType (TupleP mrow) mrow, AllZip (IsF Maybe) row mrow) =>
TeamId -> m (AllFeatures DbFeature)
getAllDbFeatures TeamId
tid = do
  Maybe (NP Maybe row)
mRow <- forall (row :: [*]) (mrow :: [*]) (m :: * -> *).
(MonadClient m, IsProductType (TupleP mrow) mrow,
 AllZip (IsF Maybe) row mrow, Tuple (TupleP mrow)) =>
TeamId -> NP (K String) row -> m (Maybe (NP Maybe row))
fetchFeatureRow @row @mrow TeamId
tid (forall (cfgs :: [*]).
ConcatColumns cfgs =>
NP (K String) (ConcatFeatureRow cfgs)
concatColumns @Features)
  AllFeatures DbFeature -> m (AllFeatures DbFeature)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllFeatures DbFeature -> m (AllFeatures DbFeature))
-> (NP Maybe row -> AllFeatures DbFeature)
-> NP Maybe row
-> m (AllFeatures DbFeature)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP Maybe row -> AllFeatures DbFeature
NP Maybe AllFeatureRow -> AllFeatures DbFeature
forall (cfgs :: [*]).
ConcatFeatures cfgs =>
NP Maybe (ConcatFeatureRow cfgs) -> NP DbFeature cfgs
rowToAllFeatures (NP Maybe row -> m (AllFeatures DbFeature))
-> NP Maybe row -> m (AllFeatures DbFeature)
forall a b. (a -> b) -> a -> b
$ NP Maybe row -> Maybe (NP Maybe row) -> NP Maybe row
forall a. a -> Maybe a -> a
fromMaybe NP Maybe row
NP Maybe AllFeatureRow
emptyRow Maybe (NP Maybe row)
mRow