{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Debug.RecoverRTTI.Classifier (
Classifier
, PrimClassifier(..)
, IsUserDefined(..)
, Classifier_(..)
, Elem(..)
, Elems(..)
, mapClassifier
) where
import Data.Aeson (Value)
import Data.HashMap.Lazy (HashMap)
import Data.HashSet (HashSet)
import Data.Int
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Kind
import Data.Map (Map)
import Data.Ratio
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.SOP
import Data.SOP.Dict
import Data.Tree (Tree)
import Data.Void
import Data.Word
import qualified Data.ByteString as BS.Strict
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Short as BS.Short
import qualified Data.HashMap.Internal.Array as HashMap (Array)
import qualified Data.Primitive.Array as Prim (Array)
import qualified Data.Text as Text.Strict
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Vector as Vector.Boxed
import Debug.RecoverRTTI.Nat
import Debug.RecoverRTTI.Tuple
import Debug.RecoverRTTI.Wrappers
type Classifier = Classifier_ IsUserDefined
data IsUserDefined a where
IsUserDefined :: UserDefined -> IsUserDefined UserDefined
instance Show (IsUserDefined a) where
show :: IsUserDefined a -> String
show (IsUserDefined UserDefined
_) = String
"IsUserDefined"
data Classifier_ (o :: Type -> Type) (a :: Type) :: Type where
C_Prim :: PrimClassifier a -> Classifier_ o a
C_Other :: o a -> Classifier_ o a
C_Maybe :: Elems o '[a] -> Classifier_ o (Maybe a)
C_Either :: Elems o '[a, b] -> Classifier_ o (Either a b)
C_List :: Elems o '[a] -> Classifier_ o [a]
C_Ratio :: Elems o '[a] -> Classifier_ o (Ratio a)
C_Set :: Elems o '[a] -> Classifier_ o (Set a)
C_Map :: Elems o '[a, b] -> Classifier_ o (Map a b)
C_IntMap :: Elems o '[a] -> Classifier_ o (IntMap a)
C_Sequence :: Elems o '[a] -> Classifier_ o (Seq a)
C_Tree :: Elems o '[a] -> Classifier_ o (Tree a)
C_HashSet :: Elems o '[a] -> Classifier_ o (HashSet a)
C_HashMap :: Elems o '[a, b] -> Classifier_ o (HashMap a b)
C_HM_Array :: Elems o '[a] -> Classifier_ o (HashMap.Array a)
C_Prim_Array :: Elems o '[a] -> Classifier_ o (Prim.Array a)
C_Vector_Boxed :: Elems o '[a] -> Classifier_ o (Vector.Boxed.Vector a)
C_Tuple ::
(SListI xs, IsValidSize (Length xs))
=> Elems o xs -> Classifier_ o (WrappedTuple xs)
data PrimClassifier (a :: Type) where
C_Bool :: PrimClassifier Bool
C_Char :: PrimClassifier Char
C_Double :: PrimClassifier Double
C_Float :: PrimClassifier Float
C_Int :: PrimClassifier Int
C_Int16 :: PrimClassifier Int16
C_Int8 :: PrimClassifier Int8
C_Int32 :: PrimClassifier Int32
C_Int64 :: PrimClassifier Int64
C_Integer :: PrimClassifier Integer
C_Ordering :: PrimClassifier Ordering
C_Unit :: PrimClassifier ()
C_Word :: PrimClassifier Word
C_Word8 :: PrimClassifier Word8
C_Word16 :: PrimClassifier Word16
C_Word32 :: PrimClassifier Word32
C_Word64 :: PrimClassifier Word64
C_String :: PrimClassifier String
C_BS_Strict :: PrimClassifier BS.Strict.ByteString
C_BS_Lazy :: PrimClassifier BS.Lazy.ByteString
C_BS_Short :: PrimClassifier BS.Short.ShortByteString
C_Text_Strict :: PrimClassifier Text.Strict.Text
C_Text_Lazy :: PrimClassifier Text.Lazy.Text
C_Value :: PrimClassifier Value
C_STRef :: PrimClassifier SomeSTRef
C_TVar :: PrimClassifier SomeTVar
C_MVar :: PrimClassifier SomeMVar
C_Fun :: PrimClassifier SomeFun
C_IntSet :: PrimClassifier IntSet
C_Prim_ArrayM :: PrimClassifier SomePrimArrayM
C_Vector_Storable :: PrimClassifier SomeStorableVector
C_Vector_StorableM :: PrimClassifier SomeStorableVectorM
C_Vector_Primitive :: PrimClassifier SomePrimitiveVector
C_Vector_PrimitiveM :: PrimClassifier SomePrimitiveVectorM
data Elem o a where
Elem :: Classifier_ o a -> Elem o a
NoElem :: Elem o Void
newtype Elems o xs = Elems (NP (Elem o) xs)
deriving instance Show (PrimClassifier a)
deriving instance (forall x. Show (o x)) => Show (Classifier_ o a)
deriving instance (forall x. Show (o x)) => Show (Elem o a)
instance (forall a. Show (o a), SListI xs) => Show (Elems o xs) where
showsPrec :: Int -> Elems o xs -> ShowS
showsPrec Int
p (Elems NP (Elem o) xs
xs) =
case NP (Dict (Compose Show (Elem o))) xs
-> Dict (All (Compose Show (Elem o))) xs
forall k (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP NP (Dict (Compose Show (Elem o))) xs
allShow of
Dict (All (Compose Show (Elem o))) xs
Dict -> Int -> NP (Elem o) xs -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p NP (Elem o) xs
xs
where
allShow :: NP (Dict (Compose Show (Elem o))) xs
allShow :: NP (Dict (Compose Show (Elem o))) xs
allShow = (forall a. Dict (Compose Show (Elem o)) a)
-> NP (Dict (Compose Show (Elem o))) 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 forall a. Dict (Compose Show (Elem o)) a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
mapClassifier :: forall m o o'.
Applicative m
=> (forall a. o a -> m (o' a))
-> (forall a. Classifier_ o a -> m (Classifier_ o' a))
mapClassifier :: (forall a. o a -> m (o' a))
-> forall a. Classifier_ o a -> m (Classifier_ o' a)
mapClassifier forall a. o a -> m (o' a)
other = Classifier_ o a -> m (Classifier_ o' a)
forall a. Classifier_ o a -> m (Classifier_ o' a)
go
where
go :: forall a. Classifier_ o a -> m (Classifier_ o' a)
go :: Classifier_ o a -> m (Classifier_ o' a)
go (C_Prim PrimClassifier a
c) = Classifier_ o' a -> m (Classifier_ o' a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimClassifier a -> Classifier_ o' a
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier a
c)
go (C_Other o a
c) = o' a -> Classifier_ o' a
forall (o :: * -> *) a. o a -> Classifier_ o a
C_Other (o' a -> Classifier_ o' a) -> m (o' a) -> m (Classifier_ o' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> o a -> m (o' a)
forall a. o a -> m (o' a)
other o a
c
go (C_Maybe Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Maybe a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Maybe a)
C_Maybe (Elems o' '[a] -> Classifier_ o' (Maybe a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Either Elems o '[a, b]
c) = Elems o' '[a, b] -> Classifier_ o' (Either a b)
forall (o :: * -> *) a b.
Elems o '[a, b] -> Classifier_ o (Either a b)
C_Either (Elems o' '[a, b] -> Classifier_ o' (Either a b))
-> m (Elems o' '[a, b]) -> m (Classifier_ o' (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a, b] -> m (Elems o' '[a, b])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a, b]
c
go (C_List Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' [a]
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o [a]
C_List (Elems o' '[a] -> Classifier_ o' [a])
-> m (Elems o' '[a]) -> m (Classifier_ o' [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Ratio Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Ratio a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Ratio a)
C_Ratio (Elems o' '[a] -> Classifier_ o' (Ratio a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Ratio a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Set Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Set a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Set a)
C_Set (Elems o' '[a] -> Classifier_ o' (Set a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Set a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Map Elems o '[a, b]
c) = Elems o' '[a, b] -> Classifier_ o' (Map a b)
forall (o :: * -> *) a b.
Elems o '[a, b] -> Classifier_ o (Map a b)
C_Map (Elems o' '[a, b] -> Classifier_ o' (Map a b))
-> m (Elems o' '[a, b]) -> m (Classifier_ o' (Map a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a, b] -> m (Elems o' '[a, b])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a, b]
c
go (C_IntMap Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (IntMap a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (IntMap a)
C_IntMap (Elems o' '[a] -> Classifier_ o' (IntMap a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (IntMap a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Sequence Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Seq a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Seq a)
C_Sequence (Elems o' '[a] -> Classifier_ o' (Seq a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Seq a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Tree Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Tree a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Tree a)
C_Tree (Elems o' '[a] -> Classifier_ o' (Tree a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Tree a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_HashSet Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (HashSet a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (HashSet a)
C_HashSet (Elems o' '[a] -> Classifier_ o' (HashSet a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (HashSet a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_HashMap Elems o '[a, b]
c) = Elems o' '[a, b] -> Classifier_ o' (HashMap a b)
forall (o :: * -> *) a b.
Elems o '[a, b] -> Classifier_ o (HashMap a b)
C_HashMap (Elems o' '[a, b] -> Classifier_ o' (HashMap a b))
-> m (Elems o' '[a, b]) -> m (Classifier_ o' (HashMap a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a, b] -> m (Elems o' '[a, b])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a, b]
c
go (C_HM_Array Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Array a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Array a)
C_HM_Array (Elems o' '[a] -> Classifier_ o' (Array a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Prim_Array Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Array a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Array a)
C_Prim_Array (Elems o' '[a] -> Classifier_ o' (Array a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Vector_Boxed Elems o '[a]
c) = Elems o' '[a] -> Classifier_ o' (Vector a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Vector a)
C_Vector_Boxed (Elems o' '[a] -> Classifier_ o' (Vector a))
-> m (Elems o' '[a]) -> m (Classifier_ o' (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o '[a] -> m (Elems o' '[a])
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o '[a]
c
go (C_Tuple Elems o xs
c) = Elems o' xs -> Classifier_ o' (WrappedTuple xs)
forall (xs :: [*]) (o :: * -> *).
(SListI xs, IsValidSize (Length xs)) =>
Elems o xs -> Classifier_ o (WrappedTuple xs)
C_Tuple (Elems o' xs -> Classifier_ o' (WrappedTuple xs))
-> m (Elems o' xs) -> m (Classifier_ o' (WrappedTuple xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elems o xs -> m (Elems o' xs)
forall (xs :: [*]). SListI xs => Elems o xs -> m (Elems o' xs)
goElems Elems o xs
c
goElems :: SListI xs => Elems o xs -> m (Elems o' xs)
goElems :: Elems o xs -> m (Elems o' xs)
goElems (Elems NP (Elem o) xs
cs) = NP (Elem o') xs -> Elems o' xs
forall (o :: * -> *) (xs :: [*]). NP (Elem o) xs -> Elems o xs
Elems (NP (Elem o') xs -> Elems o' xs)
-> m (NP (Elem o') xs) -> m (Elems o' xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Elem o a -> m (Elem o' a))
-> NP (Elem o) xs -> m (NP (Elem o') xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (g :: * -> *)
(f :: k -> *) (f' :: k -> *).
(HSequence h, SListIN h xs, Applicative g) =>
(forall (a :: k). f a -> g (f' a)) -> h f xs -> g (h f' xs)
htraverse' forall a. Elem o a -> m (Elem o' a)
goElem NP (Elem o) xs
cs
goElem :: Elem o a -> m (Elem o' a)
goElem :: Elem o a -> m (Elem o' a)
goElem (Elem Classifier_ o a
c) = Classifier_ o' a -> Elem o' a
forall (o :: * -> *) a. Classifier_ o a -> Elem o a
Elem (Classifier_ o' a -> Elem o' a)
-> m (Classifier_ o' a) -> m (Elem o' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Classifier_ o a -> m (Classifier_ o' a)
forall a. Classifier_ o a -> m (Classifier_ o' a)
go Classifier_ o a
c
goElem Elem o a
NoElem = Elem o' Void -> m (Elem o' Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Elem o' Void
forall (o :: * -> *). Elem o Void
NoElem