{-# 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, OptionalUTCTime, OptionalUTCTime, 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