{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Debug.RecoverRTTI.Classify (
    -- * Classification
    classify
    -- * User-defined types
  , Classified(..)
  , fromUserDefined
    -- * Showing values
  , anythingToString
  , canShowPrim
  , canShowClassified
  , canShowClassified_
    -- * Patterns for common shapes of 'Elems' (exported for the tests)
  , pattern ElemK
  , pattern ElemU
  , pattern ElemKK
  , pattern ElemUU
  , pattern ElemKU
  , pattern ElemUK
  ) where

import Control.Monad.Except
import Data.HashMap.Lazy (HashMap)
import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.SOP
import Data.SOP.Dict
import Data.Tree (Tree)
import Data.Void
import GHC.Exts.Heap (Closure)
import GHC.Real
import System.IO.Unsafe (unsafePerformIO)
import Unsafe.Coerce (unsafeCoerce)

import qualified Data.Foldable               as Foldable
import qualified Data.HashMap.Internal.Array as HashMap (Array)
import qualified Data.HashMap.Internal.Array as HashMap.Array
import qualified Data.HashMap.Lazy           as HashMap
import qualified Data.Map                    as Map
import qualified Data.Primitive.Array        as Prim.Array
import qualified Data.Primitive.Array        as Prim (Array)
import qualified Data.Tree                   as Tree
import qualified Data.Vector                 as Vector.Boxed

import Debug.RecoverRTTI.Classifier
import Debug.RecoverRTTI.Constraint
import Debug.RecoverRTTI.FlatClosure
import Debug.RecoverRTTI.Modules
import Debug.RecoverRTTI.Nat
import Debug.RecoverRTTI.Tuple
import Debug.RecoverRTTI.Util
import Debug.RecoverRTTI.Wrappers

{-------------------------------------------------------------------------------
  Classification
-------------------------------------------------------------------------------}

classifyIO :: a -> ExceptT Closure IO (Classifier a)
classifyIO :: a -> ExceptT Closure IO (Classifier a)
classifyIO a
x = do
    FlatClosure
closure <- IO FlatClosure -> ExceptT Closure IO FlatClosure
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FlatClosure -> ExceptT Closure IO FlatClosure)
-> IO FlatClosure -> ExceptT Closure IO FlatClosure
forall a b. (a -> b) -> a -> b
$ Box -> IO FlatClosure
getBoxedClosureData (a -> Box
forall a. a -> Box
asBox a
x)
    case FlatClosure
closure of
      --
      -- Primitive (ghc-prim)
      --

      -- GHC.Types
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"True")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Bool -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Bool -> Classifier a)
-> Classifier_ IsUserDefined Bool -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Bool -> Classifier_ IsUserDefined Bool
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Bool
C_Bool
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"False") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Bool -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Bool -> Classifier a)
-> Classifier_ IsUserDefined Bool -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Bool -> Classifier_ IsUserDefined Bool
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Bool
C_Bool
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"C#")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Char -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Char -> Classifier a)
-> Classifier_ IsUserDefined Char -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Char -> Classifier_ IsUserDefined Char
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Char
C_Char
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"D#")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Double -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Double -> Classifier a)
-> Classifier_ IsUserDefined Double -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Double -> Classifier_ IsUserDefined Double
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Double
C_Double
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"F#")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Float -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Float -> Classifier a)
-> Classifier_ IsUserDefined Float -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Float -> Classifier_ IsUserDefined Float
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Float
C_Float
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"I#")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Int -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Int -> Classifier a)
-> Classifier_ IsUserDefined Int -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Int -> Classifier_ IsUserDefined Int
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Int
C_Int
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"LT")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Ordering -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Ordering -> Classifier a)
-> Classifier_ IsUserDefined Ordering -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Ordering -> Classifier_ IsUserDefined Ordering
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Ordering
C_Ordering
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"GT")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Ordering -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Ordering -> Classifier a)
-> Classifier_ IsUserDefined Ordering -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Ordering -> Classifier_ IsUserDefined Ordering
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Ordering
C_Ordering
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"EQ")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Ordering -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Ordering -> Classifier a)
-> Classifier_ IsUserDefined Ordering -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Ordering -> Classifier_ IsUserDefined Ordering
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Ordering
C_Ordering
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"W#")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Word -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Word -> Classifier a)
-> Classifier_ IsUserDefined Word -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Word -> Classifier_ IsUserDefined Word
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Word
C_Word

      -- GHC.Tuple
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTuple -> Just String
"()") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined () -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined () -> Classifier a)
-> Classifier_ IsUserDefined () -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier () -> Classifier_ IsUserDefined ()
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier ()
C_Unit

      -- GHC.Int
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcInt -> Just String
"I8#")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Int8 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Int8 -> Classifier a)
-> Classifier_ IsUserDefined Int8 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Int8 -> Classifier_ IsUserDefined Int8
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Int8
C_Int8
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcInt -> Just String
"I16#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Int16 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Int16 -> Classifier a)
-> Classifier_ IsUserDefined Int16 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Int16 -> Classifier_ IsUserDefined Int16
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Int16
C_Int16
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcInt -> Just String
"I32#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Int32 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Int32 -> Classifier a)
-> Classifier_ IsUserDefined Int32 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Int32 -> Classifier_ IsUserDefined Int32
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Int32
C_Int32
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcInt -> Just String
"I64#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Int64 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Int64 -> Classifier a)
-> Classifier_ IsUserDefined Int64 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Int64 -> Classifier_ IsUserDefined Int64
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Int64
C_Int64

      -- GHC.Integer
      (KnownModule 'PkgIntegerWiredIn -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgIntegerWiredIn
GhcIntegerType -> Just String
"S#")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Integer -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Integer -> Classifier a)
-> Classifier_ IsUserDefined Integer -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Integer -> Classifier_ IsUserDefined Integer
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Integer
C_Integer
      (KnownModule 'PkgIntegerWiredIn -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgIntegerWiredIn
GhcIntegerType -> Just String
"Jp#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Integer -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Integer -> Classifier a)
-> Classifier_ IsUserDefined Integer -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Integer -> Classifier_ IsUserDefined Integer
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Integer
C_Integer
      (KnownModule 'PkgIntegerWiredIn -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgIntegerWiredIn
GhcIntegerType -> Just String
"Jn#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Integer -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Integer -> Classifier a)
-> Classifier_ IsUserDefined Integer -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Integer -> Classifier_ IsUserDefined Integer
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Integer
C_Integer
      (KnownModule 'PkgGhcBignum -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcBignum
GhcNumInteger  -> Just String
"IS")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Integer -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Integer -> Classifier a)
-> Classifier_ IsUserDefined Integer -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Integer -> Classifier_ IsUserDefined Integer
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Integer
C_Integer
      (KnownModule 'PkgGhcBignum -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcBignum
GhcNumInteger  -> Just String
"IP")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Integer -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Integer -> Classifier a)
-> Classifier_ IsUserDefined Integer -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Integer -> Classifier_ IsUserDefined Integer
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Integer
C_Integer
      (KnownModule 'PkgGhcBignum -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcBignum
GhcNumInteger  -> Just String
"IN")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Integer -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Integer -> Classifier a)
-> Classifier_ IsUserDefined Integer -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Integer -> Classifier_ IsUserDefined Integer
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Integer
C_Integer

      -- GHC.Word
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcWord -> Just String
"W8#")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Word8 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Word8 -> Classifier a)
-> Classifier_ IsUserDefined Word8 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Word8 -> Classifier_ IsUserDefined Word8
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Word8
C_Word8
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcWord -> Just String
"W16#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Word16 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Word16 -> Classifier a)
-> Classifier_ IsUserDefined Word16 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Word16 -> Classifier_ IsUserDefined Word16
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Word16
C_Word16
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcWord -> Just String
"W32#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Word32 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Word32 -> Classifier a)
-> Classifier_ IsUserDefined Word32 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Word32 -> Classifier_ IsUserDefined Word32
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Word32
C_Word32
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcWord -> Just String
"W64#") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Word64 -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Word64 -> Classifier a)
-> Classifier_ IsUserDefined Word64 -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Word64 -> Classifier_ IsUserDefined Word64
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Word64
C_Word64

      --
      -- String types
      --

      -- bytestring
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgByteString
DataByteStringInternal      -> Just String
"PS")    -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined ByteString -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined ByteString -> Classifier a)
-> Classifier_ IsUserDefined ByteString -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier ByteString -> Classifier_ IsUserDefined ByteString
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier ByteString
C_BS_Strict
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgByteString
DataByteStringLazyInternal  -> Just String
"Empty") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined ByteString -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined ByteString -> Classifier a)
-> Classifier_ IsUserDefined ByteString -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier ByteString -> Classifier_ IsUserDefined ByteString
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier ByteString
C_BS_Lazy
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgByteString
DataByteStringLazyInternal  -> Just String
"Chunk") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined ByteString -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined ByteString -> Classifier a)
-> Classifier_ IsUserDefined ByteString -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier ByteString -> Classifier_ IsUserDefined ByteString
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier ByteString
C_BS_Lazy
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgByteString
DataByteStringShortInternal -> Just String
"SBS")   -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined ShortByteString -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined ShortByteString -> Classifier a)
-> Classifier_ IsUserDefined ShortByteString -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier ShortByteString
-> Classifier_ IsUserDefined ShortByteString
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier ShortByteString
C_BS_Short

      -- text
      (KnownModule 'PkgText -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgText
DataTextInternal     -> Just String
"Text")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Text -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Text -> Classifier a)
-> Classifier_ IsUserDefined Text -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Text -> Classifier_ IsUserDefined Text
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Text
C_Text_Strict
      (KnownModule 'PkgText -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgText
DataTextInternalLazy -> Just String
"Chunk") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Text -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Text -> Classifier a)
-> Classifier_ IsUserDefined Text -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Text -> Classifier_ IsUserDefined Text
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Text
C_Text_Lazy
      (KnownModule 'PkgText -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgText
DataTextInternalLazy -> Just String
"Empty") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Text -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Text -> Classifier a)
-> Classifier_ IsUserDefined Text -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Text -> Classifier_ IsUserDefined Text
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Text
C_Text_Lazy

      --
      -- Aeson
      --

      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgAeson
DataAesonTypesInternal -> Just String
"Object") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Value -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Value -> Classifier a)
-> Classifier_ IsUserDefined Value -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Value -> Classifier_ IsUserDefined Value
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgAeson
DataAesonTypesInternal -> Just String
"Array")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Value -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Value -> Classifier a)
-> Classifier_ IsUserDefined Value -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Value -> Classifier_ IsUserDefined Value
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgAeson
DataAesonTypesInternal -> Just String
"String") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Value -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Value -> Classifier a)
-> Classifier_ IsUserDefined Value -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Value -> Classifier_ IsUserDefined Value
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgAeson
DataAesonTypesInternal -> Just String
"Number") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Value -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Value -> Classifier a)
-> Classifier_ IsUserDefined Value -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Value -> Classifier_ IsUserDefined Value
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgAeson
DataAesonTypesInternal -> Just String
"Bool")   -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Value -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Value -> Classifier a)
-> Classifier_ IsUserDefined Value -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Value -> Classifier_ IsUserDefined Value
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgAeson
DataAesonTypesInternal -> Just String
"Null")   -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined Value -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined Value -> Classifier a)
-> Classifier_ IsUserDefined Value -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier Value -> Classifier_ IsUserDefined Value
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier Value
C_Value

      --
      -- Compound (ghc-prim)
      --

      -- Maybe
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcMaybe -> Just String
"Nothing") ->
        Classifier_ IsUserDefined (Maybe Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Maybe Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Maybe Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Maybe Any))
forall a. Maybe a -> ExceptT Closure IO (Classifier (Maybe a))
classifyMaybe (a -> Maybe Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcMaybe -> Just String
"Just") ->
        Classifier_ IsUserDefined (Maybe Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Maybe Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Maybe Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Maybe Any))
forall a. Maybe a -> ExceptT Closure IO (Classifier (Maybe a))
classifyMaybe (a -> Maybe Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Either
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
DataEither -> Just String
"Left") ->
        Classifier_ IsUserDefined (Either Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Either Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Either Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Either Any Any))
forall a b.
Either a b -> ExceptT Closure IO (Classifier (Either a b))
classifyEither (a -> Either Any Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
DataEither -> Just String
"Right") ->
        Classifier_ IsUserDefined (Either Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Either Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Either Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Either Any Any))
forall a b.
Either a b -> ExceptT Closure IO (Classifier (Either a b))
classifyEither (a -> Either Any Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Lists (this includes the 'String' case)
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"[]") ->
        Classifier_ IsUserDefined [Any] -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined [Any] -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined [Any])
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Any] -> ExceptT Closure IO (Classifier_ IsUserDefined [Any])
forall a. [a] -> ExceptT Closure IO (Classifier [a])
classifyList (a -> [Any]
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
":") ->
        Classifier_ IsUserDefined [Any] -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined [Any] -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined [Any])
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Any] -> ExceptT Closure IO (Classifier_ IsUserDefined [Any])
forall a. [a] -> ExceptT Closure IO (Classifier [a])
classifyList (a -> [Any]
forall a b. a -> b
unsafeCoerce a
x)

      -- Ratio
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcReal -> Just String
":%") ->
        Classifier_ IsUserDefined (Ratio Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Ratio Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Ratio Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ratio Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Ratio Any))
forall a. Ratio a -> ExceptT Closure IO (Classifier (Ratio a))
classifyRatio (a -> Ratio Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Set
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSetInternal -> Just String
"Tip") ->
        Classifier_ IsUserDefined (Set Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Set Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Set Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Any -> ExceptT Closure IO (Classifier_ IsUserDefined (Set Any))
forall a. Set a -> ExceptT Closure IO (Classifier (Set a))
classifySet (a -> Set Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSetInternal -> Just String
"Bin") ->
        Classifier_ IsUserDefined (Set Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Set Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Set Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Any -> ExceptT Closure IO (Classifier_ IsUserDefined (Set Any))
forall a. Set a -> ExceptT Closure IO (Classifier (Set a))
classifySet (a -> Set Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Map
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataMapInternal -> Just String
"Tip") ->
        Classifier_ IsUserDefined (Map Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Map Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Map Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Map Any Any))
forall a b. Map a b -> ExceptT Closure IO (Classifier (Map a b))
classifyMap (a -> Map Any Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataMapInternal -> Just String
"Bin") ->
        Classifier_ IsUserDefined (Map Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Map Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Map Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Map Any Any))
forall a b. Map a b -> ExceptT Closure IO (Classifier (Map a b))
classifyMap (a -> Map Any Any
forall a b. a -> b
unsafeCoerce a
x)

      -- IntSet
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntSetInternal -> Just String
"Bin") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined IntSet -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined IntSet -> Classifier a)
-> Classifier_ IsUserDefined IntSet -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier IntSet -> Classifier_ IsUserDefined IntSet
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier IntSet
C_IntSet
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntSetInternal -> Just String
"Tip") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined IntSet -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined IntSet -> Classifier a)
-> Classifier_ IsUserDefined IntSet -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier IntSet -> Classifier_ IsUserDefined IntSet
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier IntSet
C_IntSet
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntSetInternal -> Just String
"Nil") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined IntSet -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined IntSet -> Classifier a)
-> Classifier_ IsUserDefined IntSet -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier IntSet -> Classifier_ IsUserDefined IntSet
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier IntSet
C_IntSet

      -- IntMap
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntMapInternal -> Just String
"Nil") ->
        Classifier_ IsUserDefined (IntMap Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (IntMap Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (IntMap Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (IntMap Any))
forall a. IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap (a -> IntMap Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntMapInternal -> Just String
"Tip") ->
        Classifier_ IsUserDefined (IntMap Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (IntMap Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (IntMap Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (IntMap Any))
forall a. IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap (a -> IntMap Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntMapInternal -> Just String
"Bin") ->
        Classifier_ IsUserDefined (IntMap Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (IntMap Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (IntMap Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (IntMap Any))
forall a. IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap (a -> IntMap Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Sequence
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSequenceInternal -> Just String
"EmptyT") ->
        Classifier_ IsUserDefined (Seq Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Seq Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Seq Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Any -> ExceptT Closure IO (Classifier_ IsUserDefined (Seq Any))
forall a. Seq a -> ExceptT Closure IO (Classifier (Seq a))
classifySequence (a -> Seq Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSequenceInternal -> Just String
"Single") ->
        Classifier_ IsUserDefined (Seq Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Seq Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Seq Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Any -> ExceptT Closure IO (Classifier_ IsUserDefined (Seq Any))
forall a. Seq a -> ExceptT Closure IO (Classifier (Seq a))
classifySequence (a -> Seq Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSequenceInternal -> Just String
"Deep") ->
        Classifier_ IsUserDefined (Seq Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Seq Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Seq Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Any -> ExceptT Closure IO (Classifier_ IsUserDefined (Seq Any))
forall a. Seq a -> ExceptT Closure IO (Classifier (Seq a))
classifySequence (a -> Seq Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Tree
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataTree -> Just String
"Node") ->
        Classifier_ IsUserDefined (Tree Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Tree Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Tree Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Tree Any))
forall a. Tree a -> ExceptT Closure IO (Classifier (Tree a))
classifyTree (a -> Tree Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Tuples (of size 2..62)
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe (String, [Box])
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
inKnownModuleNested KnownModule 'PkgGhcPrim
GhcTuple -> Just (
            String -> Maybe (Some ValidSize)
isTuple       -> Just (Some validSize :: ValidSize a
validSize@(ValidSize SNat a
sz forall r. TooBig a -> r
_))
          , SNat a -> [Box] -> Maybe (VerifiedSize a Box)
forall (n :: Nat) a. SNat n -> [a] -> Maybe (VerifiedSize n a)
verifySize SNat a
sz -> Just (VerifiedSize NP (K Box) xs
ptrs)
          )) ->
        case ValidSize a -> Dict IsValidSize a
forall (n :: Nat). ValidSize n -> Dict IsValidSize n
liftValidSize ValidSize a
validSize of
          Dict IsValidSize a
Dict -> Classifier_ IsUserDefined (WrappedTuple xs) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (WrappedTuple xs) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (WrappedTuple xs))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP (K Box) xs
-> ExceptT Closure IO (Classifier_ IsUserDefined (WrappedTuple xs))
forall (xs :: [*]).
(SListI xs, IsValidSize (Length xs)) =>
NP (K Box) xs -> ExceptT Closure IO (Classifier (WrappedTuple xs))
classifyTuple NP (K Box) xs
ptrs

      -- HashMap
      --
      -- This could also be a HashSet, which is a newtype around a HashMap;
      -- we distinguish in 'classifyHashMap'.
      (KnownModule 'PkgUnorderedContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Empty") ->
        Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
forall a b.
HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap (a -> HashMap Any Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgUnorderedContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"BitmapIndexed") ->
        Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
forall a b.
HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap (a -> HashMap Any Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgUnorderedContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Leaf") ->
        Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
forall a b.
HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap (a -> HashMap Any Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgUnorderedContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Full") ->
        Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
forall a b.
HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap (a -> HashMap Any Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgUnorderedContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Collision") ->
        Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Any Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (HashMap Any Any))
forall a b.
HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap (a -> HashMap Any Any
forall a b. a -> b
unsafeCoerce a
x)

      -- HashMap's internal Array type
      (KnownModule 'PkgUnorderedContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternalArray -> Just String
"Array") ->
        Classifier_ IsUserDefined (Array Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Array Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Array Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Array Any))
forall a. Array a -> ExceptT Closure IO (Classifier (Array a))
classifyHMArray (a -> Array Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Arrays from @primitive@
      (KnownModule 'PkgPrimitive -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgPrimitive
DataPrimitiveArray -> Just String
"Array") ->
        Classifier_ IsUserDefined (Array Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Array Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Array Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Array Any))
forall a. Array a -> ExceptT Closure IO (Classifier (Array a))
classifyPrimArray (a -> Array Any
forall a b. a -> b
unsafeCoerce a
x)
      (KnownModule 'PkgPrimitive -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgPrimitive
DataPrimitiveArray -> Just String
"MutableArray") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomePrimArrayM -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomePrimArrayM -> Classifier a)
-> Classifier_ IsUserDefined SomePrimArrayM -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomePrimArrayM
-> Classifier_ IsUserDefined SomePrimArrayM
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomePrimArrayM
C_Prim_ArrayM

      -- Boxed vectors
      (KnownModule 'PkgVector -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgVector
DataVector -> Just String
"Vector") ->
        Classifier_ IsUserDefined (Vector Any) -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Vector Any) -> Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined (Vector Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Any
-> ExceptT Closure IO (Classifier_ IsUserDefined (Vector Any))
forall a. Vector a -> ExceptT Closure IO (Classifier (Vector a))
classifyVectorBoxed (a -> Vector Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Storable vectors
      (KnownModule 'PkgVector -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgVector
DataVectorStorable -> Just String
"Vector") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomeStorableVector -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomeStorableVector -> Classifier a)
-> Classifier_ IsUserDefined SomeStorableVector -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomeStorableVector
-> Classifier_ IsUserDefined SomeStorableVector
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomeStorableVector
C_Vector_Storable
      (KnownModule 'PkgVector -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgVector
DataVectorStorableMutable -> Just String
"MVector") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomeStorableVectorM -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomeStorableVectorM -> Classifier a)
-> Classifier_ IsUserDefined SomeStorableVectorM -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomeStorableVectorM
-> Classifier_ IsUserDefined SomeStorableVectorM
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomeStorableVectorM
C_Vector_StorableM

      -- Primitive vectors
      (KnownModule 'PkgVector -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgVector
DataVectorPrimitive -> Just String
"Vector") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomePrimitiveVector -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomePrimitiveVector -> Classifier a)
-> Classifier_ IsUserDefined SomePrimitiveVector -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomePrimitiveVector
-> Classifier_ IsUserDefined SomePrimitiveVector
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomePrimitiveVector
C_Vector_Primitive
      (KnownModule 'PkgVector -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgVector
DataVectorPrimitiveMutable -> Just String
"MVector") ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomePrimitiveVectorM -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomePrimitiveVectorM -> Classifier a)
-> Classifier_ IsUserDefined SomePrimitiveVectorM -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomePrimitiveVectorM
-> Classifier_ IsUserDefined SomePrimitiveVectorM
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomePrimitiveVectorM
C_Vector_PrimitiveM

      --
      -- Reference cells
      --

      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcSTRef    -> Just String
"STRef") -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomeSTRef -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomeSTRef -> Classifier a)
-> Classifier_ IsUserDefined SomeSTRef -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomeSTRef -> Classifier_ IsUserDefined SomeSTRef
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomeSTRef
C_STRef
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcMVar     -> Just String
"MVar")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomeMVar -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomeMVar -> Classifier a)
-> Classifier_ IsUserDefined SomeMVar -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomeMVar -> Classifier_ IsUserDefined SomeMVar
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomeMVar
C_MVar
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
IsKnownPkg pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcConcSync -> Just String
"TVar")  -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomeTVar -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomeTVar -> Classifier a)
-> Classifier_ IsUserDefined SomeTVar -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomeTVar -> Classifier_ IsUserDefined SomeTVar
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomeTVar
C_TVar

      --
      -- Functions
      --

      FunClosure {} -> Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined SomeFun -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined SomeFun -> Classifier a)
-> Classifier_ IsUserDefined SomeFun -> Classifier a
forall a b. (a -> b) -> a -> b
$ PrimClassifier SomeFun -> Classifier_ IsUserDefined SomeFun
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier SomeFun
C_Fun

      --
      -- User defined
      --

      ConstrClosure {} ->
        Classifier a -> ExceptT Closure IO (Classifier a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier a -> ExceptT Closure IO (Classifier a))
-> Classifier a -> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined UserDefined -> Classifier a
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined UserDefined -> Classifier a)
-> Classifier_ IsUserDefined UserDefined -> Classifier a
forall a b. (a -> b) -> a -> b
$ IsUserDefined UserDefined -> Classifier_ IsUserDefined UserDefined
forall (o :: * -> *) a. o a -> Classifier_ o a
C_Other (UserDefined -> IsUserDefined UserDefined
IsUserDefined (a -> UserDefined
forall a b. a -> b
unsafeCoerce a
x))

      --
      -- Classification failed
      --

      OtherClosure Closure
other -> IO (Either Closure (Classifier a))
-> ExceptT Closure IO (Classifier a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Closure (Classifier a))
 -> ExceptT Closure IO (Classifier a))
-> IO (Either Closure (Classifier a))
-> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ Either Closure (Classifier a) -> IO (Either Closure (Classifier a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Closure -> Either Closure (Classifier a)
forall a b. a -> Either a b
Left Closure
other)

mustBe :: Classifier_ o b -> Classifier_ o a
mustBe :: Classifier_ o b -> Classifier_ o a
mustBe = Classifier_ o b -> Classifier_ o a
forall a b. a -> b
unsafeCoerce

-- | Classify a value
--
-- Given a value of some unknown type @a@ and a classifier @Classifier a@,
-- it should be sound to coerce the value to the type indicated by the
-- classifier.
--
-- This is also the reason not all values can be classified; in particular,
-- we cannot classify values of unlifted types, as for these types coercion
-- does not work (this would result in a ghc runtime crash).
classify :: a -> Either Closure (Classifier a)
classify :: a -> Either Closure (Classifier a)
classify = IO (Either Closure (Classifier a)) -> Either Closure (Classifier a)
forall a. IO a -> a
unsafePerformIO (IO (Either Closure (Classifier a))
 -> Either Closure (Classifier a))
-> (a -> IO (Either Closure (Classifier a)))
-> a
-> Either Closure (Classifier a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Closure IO (Classifier a)
-> IO (Either Closure (Classifier a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Closure IO (Classifier a)
 -> IO (Either Closure (Classifier a)))
-> (a -> ExceptT Closure IO (Classifier a))
-> a
-> IO (Either Closure (Classifier a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO

{-------------------------------------------------------------------------------
  Classification for compound types
-------------------------------------------------------------------------------}

classifyMaybe :: Maybe a -> ExceptT Closure IO (Classifier (Maybe a))
classifyMaybe :: Maybe a -> ExceptT Closure IO (Classifier (Maybe a))
classifyMaybe = (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Maybe x))
-> Maybe a -> ExceptT Closure IO (Classifier (Maybe a))
forall (f :: * -> *) a.
Foldable f =>
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Maybe x)
C_Maybe

classifyEither ::
     Either a b
  -> ExceptT Closure IO (Classifier (Either a b))
classifyEither :: Either a b -> ExceptT Closure IO (Classifier (Either a b))
classifyEither Either a b
x =
    case Either a b
x of
      Left  a
x' -> (Classifier_ IsUserDefined (Either a Void)
-> Classifier (Either a b)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Either a Void)
 -> Classifier (Either a b))
-> (Classifier_ IsUserDefined a
    -> Classifier_ IsUserDefined (Either a Void))
-> Classifier_ IsUserDefined a
-> Classifier (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elems IsUserDefined '[a, Void]
-> Classifier_ IsUserDefined (Either a Void)
forall (o :: * -> *) a b.
Elems o '[a, b] -> Classifier_ o (Either a b)
C_Either (Elems IsUserDefined '[a, Void]
 -> Classifier_ IsUserDefined (Either a Void))
-> (Classifier_ IsUserDefined a -> Elems IsUserDefined '[a, Void])
-> Classifier_ IsUserDefined a
-> Classifier_ IsUserDefined (Either a Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classifier_ IsUserDefined a -> Elems IsUserDefined '[a, Void]
forall (o :: * -> *) a. Classifier_ o a -> Elems o '[a, Void]
ElemKU)  (Classifier_ IsUserDefined a -> Classifier (Either a b))
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> ExceptT Closure IO (Classifier (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
      Right b
y' -> (Classifier_ IsUserDefined (Either Void b)
-> Classifier (Either a b)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (Either Void b)
 -> Classifier (Either a b))
-> (Classifier_ IsUserDefined b
    -> Classifier_ IsUserDefined (Either Void b))
-> Classifier_ IsUserDefined b
-> Classifier (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elems IsUserDefined '[Void, b]
-> Classifier_ IsUserDefined (Either Void b)
forall (o :: * -> *) a b.
Elems o '[a, b] -> Classifier_ o (Either a b)
C_Either (Elems IsUserDefined '[Void, b]
 -> Classifier_ IsUserDefined (Either Void b))
-> (Classifier_ IsUserDefined b -> Elems IsUserDefined '[Void, b])
-> Classifier_ IsUserDefined b
-> Classifier_ IsUserDefined (Either Void b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classifier_ IsUserDefined b -> Elems IsUserDefined '[Void, b]
forall (o :: * -> *) b. Classifier_ o b -> Elems o '[Void, b]
ElemUK) (Classifier_ IsUserDefined b -> Classifier (Either a b))
-> ExceptT Closure IO (Classifier_ IsUserDefined b)
-> ExceptT Closure IO (Classifier (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> ExceptT Closure IO (Classifier_ IsUserDefined b)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO b
y'

classifyList :: [a] -> ExceptT Closure IO (Classifier [a])
classifyList :: [a] -> ExceptT Closure IO (Classifier [a])
classifyList = (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o [x])
-> [a] -> ExceptT Closure IO (Classifier [a])
forall (f :: * -> *) a.
Foldable f =>
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o [x]
c_list
  where
    -- We special case for @String@, so that @show@ will use the (overlapped)
    -- instance for @String@ instead of the general instance for @[a]@
    c_list :: Elems o '[x] -> Classifier_ o [x]
    c_list :: Elems o '[x] -> Classifier_ o [x]
c_list (ElemK (C_Prim PrimClassifier x
C_Char)) = PrimClassifier String -> Classifier_ o String
forall a (o :: * -> *). PrimClassifier a -> Classifier_ o a
C_Prim PrimClassifier String
C_String
    c_list Elems o '[x]
c = Elems o '[x] -> Classifier_ o [x]
forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o [x]
C_List Elems o '[x]
c

classifyRatio :: Ratio a -> ExceptT Closure IO (Classifier (Ratio a))
classifyRatio :: Ratio a -> ExceptT Closure IO (Classifier (Ratio a))
classifyRatio (a
x' :% a
_) = Classifier (Ratio a) -> Classifier (Ratio a)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier (Ratio a) -> Classifier (Ratio a))
-> (Classifier_ IsUserDefined a -> Classifier (Ratio a))
-> Classifier_ IsUserDefined a
-> Classifier (Ratio a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elems IsUserDefined '[a] -> Classifier (Ratio a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Ratio a)
C_Ratio (Elems IsUserDefined '[a] -> Classifier (Ratio a))
-> (Classifier_ IsUserDefined a -> Elems IsUserDefined '[a])
-> Classifier_ IsUserDefined a
-> Classifier (Ratio a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classifier_ IsUserDefined a -> Elems IsUserDefined '[a]
forall (o :: * -> *) a. Classifier_ o a -> Elems o '[a]
ElemK (Classifier_ IsUserDefined a -> Classifier (Ratio a))
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> ExceptT Closure IO (Classifier (Ratio a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'

classifySet :: Set a -> ExceptT Closure IO (Classifier (Set a))
classifySet :: Set a -> ExceptT Closure IO (Classifier (Set a))
classifySet = (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Set x))
-> Set a -> ExceptT Closure IO (Classifier (Set a))
forall (f :: * -> *) a.
Foldable f =>
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Set x)
C_Set

classifyMap :: Map a b -> ExceptT Closure IO (Classifier (Map a b))
classifyMap :: Map a b -> ExceptT Closure IO (Classifier (Map a b))
classifyMap = (forall (o :: * -> *) x y.
 Elems o '[x, y] -> Classifier_ o (Map x y))
-> (Map a b -> [(a, b)])
-> Map a b
-> ExceptT Closure IO (Classifier (Map a b))
forall (f :: * -> * -> *) a b.
(forall (o :: * -> *) x y.
 Elems o '[x, y] -> Classifier_ o (f x y))
-> (f a b -> [(a, b)])
-> f a b
-> ExceptT Closure IO (Classifier (f a b))
classifyFoldablePair forall (o :: * -> *) x y.
Elems o '[x, y] -> Classifier_ o (Map x y)
C_Map Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList

classifyIntMap :: IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap :: IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap = (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (IntMap x))
-> IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
forall (f :: * -> *) a.
Foldable f =>
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (IntMap x)
C_IntMap

classifySequence :: Seq a -> ExceptT Closure IO (Classifier (Seq a))
classifySequence :: Seq a -> ExceptT Closure IO (Classifier (Seq a))
classifySequence = (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Seq x))
-> Seq a -> ExceptT Closure IO (Classifier (Seq a))
forall (f :: * -> *) a.
Foldable f =>
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Seq x)
C_Sequence

classifyTree :: Tree a -> ExceptT Closure IO (Classifier (Tree a))
classifyTree :: Tree a -> ExceptT Closure IO (Classifier (Tree a))
classifyTree (Tree.Node a
x' Forest a
_) = Classifier (Tree a) -> Classifier (Tree a)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier (Tree a) -> Classifier (Tree a))
-> (Classifier_ IsUserDefined a -> Classifier (Tree a))
-> Classifier_ IsUserDefined a
-> Classifier (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elems IsUserDefined '[a] -> Classifier (Tree a)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (Tree a)
C_Tree (Elems IsUserDefined '[a] -> Classifier (Tree a))
-> (Classifier_ IsUserDefined a -> Elems IsUserDefined '[a])
-> Classifier_ IsUserDefined a
-> Classifier (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classifier_ IsUserDefined a -> Elems IsUserDefined '[a]
forall (o :: * -> *) a. Classifier_ o a -> Elems o '[a]
ElemK (Classifier_ IsUserDefined a -> Classifier (Tree a))
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> ExceptT Closure IO (Classifier (Tree a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'

classifyHashMap :: HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap :: HashMap a b -> ExceptT Closure IO (Classifier (HashMap a b))
classifyHashMap = (forall (o :: * -> *) x y.
 Elems o '[x, y] -> Classifier_ o (HashMap x y))
-> (HashMap a b -> [(a, b)])
-> HashMap a b
-> ExceptT Closure IO (Classifier (HashMap a b))
forall (f :: * -> * -> *) a b.
(forall (o :: * -> *) x y.
 Elems o '[x, y] -> Classifier_ o (f x y))
-> (f a b -> [(a, b)])
-> f a b
-> ExceptT Closure IO (Classifier (f a b))
classifyFoldablePair forall (o :: * -> *) x y.
Elems o '[x, y] -> Classifier_ o (HashMap x y)
c_hashmap HashMap a b -> [(a, b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
  where
    -- HashSet is a newtype around HashMap
    c_hashmap :: Elems o '[x, y] -> Classifier_ o (HashMap x y)
    c_hashmap :: Elems o '[x, y] -> Classifier_ o (HashMap x y)
c_hashmap (ElemKK Classifier_ o x
c (C_Prim PrimClassifier y
C_Unit)) = Classifier_ o (HashSet x) -> Classifier_ o (HashMap x y)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ o (HashSet x) -> Classifier_ o (HashMap x y))
-> Classifier_ o (HashSet x) -> Classifier_ o (HashMap x y)
forall a b. (a -> b) -> a -> b
$ Elems o '[x] -> Classifier_ o (HashSet x)
forall (o :: * -> *) a. Elems o '[a] -> Classifier_ o (HashSet a)
C_HashSet (Classifier_ o x -> Elems o '[x]
forall (o :: * -> *) a. Classifier_ o a -> Elems o '[a]
ElemK Classifier_ o x
c)
    c_hashmap Elems o '[x, y]
c = Elems o '[x, y] -> Classifier_ o (HashMap x y)
forall (o :: * -> *) x y.
Elems o '[x, y] -> Classifier_ o (HashMap x y)
C_HashMap Elems o '[x, y]
c

classifyHMArray ::
     HashMap.Array a
  -> ExceptT Closure IO (Classifier (HashMap.Array a))
classifyHMArray :: Array a -> ExceptT Closure IO (Classifier (Array a))
classifyHMArray =
    (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Array x))
-> (Array a -> Int)
-> (Array a -> a)
-> Array a
-> ExceptT Closure IO (Classifier (Array a))
forall (f :: * -> *) a.
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> (f a -> Int)
-> (f a -> a)
-> f a
-> ExceptT Closure IO (Classifier (f a))
classifyArrayLike
      forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Array x)
C_HM_Array
      Array a -> Int
forall a. Array a -> Int
HashMap.Array.length
      (Array a -> Int -> a
forall a. Array a -> Int -> a
`HashMap.Array.index` Int
0)

classifyPrimArray ::
     Prim.Array a
  -> ExceptT Closure IO (Classifier (Prim.Array a))
classifyPrimArray :: Array a -> ExceptT Closure IO (Classifier (Array a))
classifyPrimArray =
    (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Array x))
-> (Array a -> Int)
-> (Array a -> a)
-> Array a
-> ExceptT Closure IO (Classifier (Array a))
forall (f :: * -> *) a.
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> (f a -> Int)
-> (f a -> a)
-> f a
-> ExceptT Closure IO (Classifier (f a))
classifyArrayLike
      forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Array x)
C_Prim_Array
      Array a -> Int
forall a. Array a -> Int
Prim.Array.sizeofArray
      (Array a -> Int -> a
forall a. Array a -> Int -> a
`Prim.Array.indexArray` Int
0)

classifyVectorBoxed ::
     Vector.Boxed.Vector a
  -> ExceptT Closure IO (Classifier (Vector.Boxed.Vector a))
classifyVectorBoxed :: Vector a -> ExceptT Closure IO (Classifier (Vector a))
classifyVectorBoxed =
    (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Vector x))
-> (Vector a -> Int)
-> (Vector a -> a)
-> Vector a
-> ExceptT Closure IO (Classifier (Vector a))
forall (f :: * -> *) a.
(forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> (f a -> Int)
-> (f a -> a)
-> f a
-> ExceptT Closure IO (Classifier (f a))
classifyArrayLike
      forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (Vector x)
C_Vector_Boxed
      Vector a -> Int
forall a. Vector a -> Int
Vector.Boxed.length
      Vector a -> a
forall a. Vector a -> a
Vector.Boxed.head

classifyTuple ::
     (SListI xs, IsValidSize (Length xs))
  => NP (K Box) xs
  -> ExceptT Closure IO (Classifier (WrappedTuple xs))
classifyTuple :: NP (K Box) xs -> ExceptT Closure IO (Classifier (WrappedTuple xs))
classifyTuple NP (K Box) xs
ptrs = do
    NP Classifier xs
cs <- NP (ExceptT Closure IO :.: Classifier) xs
-> ExceptT Closure IO (NP Classifier xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' ((forall a. K Box a -> (:.:) (ExceptT Closure IO) Classifier a)
-> NP (K Box) xs -> NP (ExceptT Closure IO :.: Classifier) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap forall a. K Box a -> (:.:) (ExceptT Closure IO) Classifier a
aux NP (K Box) xs
ptrs)
    Classifier (WrappedTuple xs)
-> ExceptT Closure IO (Classifier (WrappedTuple xs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (WrappedTuple xs)
 -> ExceptT Closure IO (Classifier (WrappedTuple xs)))
-> Classifier (WrappedTuple xs)
-> ExceptT Closure IO (Classifier (WrappedTuple xs))
forall a b. (a -> b) -> a -> b
$ Elems IsUserDefined xs -> Classifier (WrappedTuple xs)
forall (xs :: [*]) (o :: * -> *).
(SListI xs, IsValidSize (Length xs)) =>
Elems o xs -> Classifier_ o (WrappedTuple xs)
C_Tuple (NP (Elem IsUserDefined) xs -> Elems IsUserDefined xs
forall (o :: * -> *) (xs :: [*]). NP (Elem o) xs -> Elems o xs
Elems ((forall a. Classifier a -> Elem IsUserDefined a)
-> NP Classifier xs -> NP (Elem IsUserDefined) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap forall a. Classifier a -> Elem IsUserDefined a
forall (o :: * -> *) a. Classifier_ o a -> Elem o a
Elem NP Classifier xs
cs))
  where
    aux :: K Box a -> (ExceptT Closure IO :.: Classifier) a
    aux :: K Box a -> (:.:) (ExceptT Closure IO) Classifier a
aux (K (Box Any
x)) = ExceptT Closure IO (Classifier_ IsUserDefined a)
-> (:.:) (ExceptT Closure IO) Classifier a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (ExceptT Closure IO (Classifier_ IsUserDefined a)
 -> (:.:) (ExceptT Closure IO) Classifier a)
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> (:.:) (ExceptT Closure IO) Classifier a
forall a b. (a -> b) -> a -> b
$ a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO (Any -> a
forall a b. a -> b
unsafeCoerce Any
x)

{-------------------------------------------------------------------------------
  Helper functions for defining classifiers
-------------------------------------------------------------------------------}

classifyFoldable ::
     Foldable f
  => (forall o x. Elems o '[x] -> Classifier_ o (f x))
  -> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable :: (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> f a -> ExceptT Closure IO (Classifier (f a))
classifyFoldable forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x)
cc f a
x =
    case f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f a
x of
      []   -> Classifier (f a) -> ExceptT Closure IO (Classifier (f a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (f a) -> ExceptT Closure IO (Classifier (f a)))
-> Classifier (f a) -> ExceptT Closure IO (Classifier (f a))
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined (f Void) -> Classifier (f a)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (f Void) -> Classifier (f a))
-> Classifier_ IsUserDefined (f Void) -> Classifier (f a)
forall a b. (a -> b) -> a -> b
$ Elems IsUserDefined '[Void] -> Classifier_ IsUserDefined (f Void)
forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x)
cc Elems IsUserDefined '[Void]
forall (o :: * -> *). Elems o '[Void]
ElemU
      a
x':[a]
_ -> Classifier (f a) -> Classifier (f a)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier (f a) -> Classifier (f a))
-> (Classifier_ IsUserDefined a -> Classifier (f a))
-> Classifier_ IsUserDefined a
-> Classifier (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elems IsUserDefined '[a] -> Classifier (f a)
forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x)
cc (Elems IsUserDefined '[a] -> Classifier (f a))
-> (Classifier_ IsUserDefined a -> Elems IsUserDefined '[a])
-> Classifier_ IsUserDefined a
-> Classifier (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classifier_ IsUserDefined a -> Elems IsUserDefined '[a]
forall (o :: * -> *) a. Classifier_ o a -> Elems o '[a]
ElemK (Classifier_ IsUserDefined a -> Classifier (f a))
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> ExceptT Closure IO (Classifier (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'

classifyFoldablePair ::
     (forall o x y. Elems o '[x, y] -> Classifier_ o (f x y))
  -> (f a b -> [(a, b)])
  -> f a b -> ExceptT Closure IO (Classifier (f a b))
classifyFoldablePair :: (forall (o :: * -> *) x y.
 Elems o '[x, y] -> Classifier_ o (f x y))
-> (f a b -> [(a, b)])
-> f a b
-> ExceptT Closure IO (Classifier (f a b))
classifyFoldablePair forall (o :: * -> *) x y. Elems o '[x, y] -> Classifier_ o (f x y)
cc f a b -> [(a, b)]
toList f a b
x =
    case f a b -> [(a, b)]
toList f a b
x of
      []         -> Classifier (f a b) -> ExceptT Closure IO (Classifier (f a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (f a b) -> ExceptT Closure IO (Classifier (f a b)))
-> Classifier (f a b) -> ExceptT Closure IO (Classifier (f a b))
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined (f Void Void) -> Classifier (f a b)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (f Void Void) -> Classifier (f a b))
-> Classifier_ IsUserDefined (f Void Void) -> Classifier (f a b)
forall a b. (a -> b) -> a -> b
$ Elems IsUserDefined '[Void, Void]
-> Classifier_ IsUserDefined (f Void Void)
forall (o :: * -> *) x y. Elems o '[x, y] -> Classifier_ o (f x y)
cc Elems IsUserDefined '[Void, Void]
forall (o :: * -> *). Elems o '[Void, Void]
ElemUU
      (a
x', b
y'):[(a, b)]
_ -> (\Classifier_ IsUserDefined a
ca Classifier_ IsUserDefined b
cb -> Classifier (f a b) -> Classifier (f a b)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier (f a b) -> Classifier (f a b))
-> Classifier (f a b) -> Classifier (f a b)
forall a b. (a -> b) -> a -> b
$ Elems IsUserDefined '[a, b] -> Classifier (f a b)
forall (o :: * -> *) x y. Elems o '[x, y] -> Classifier_ o (f x y)
cc (Classifier_ IsUserDefined a
-> Classifier_ IsUserDefined b -> Elems IsUserDefined '[a, b]
forall (o :: * -> *) a b.
Classifier_ o a -> Classifier_ o b -> Elems o '[a, b]
ElemKK Classifier_ IsUserDefined a
ca Classifier_ IsUserDefined b
cb))
                       (Classifier_ IsUserDefined a
 -> Classifier_ IsUserDefined b -> Classifier (f a b))
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> ExceptT
     Closure IO (Classifier_ IsUserDefined b -> Classifier (f a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
                       ExceptT
  Closure IO (Classifier_ IsUserDefined b -> Classifier (f a b))
-> ExceptT Closure IO (Classifier_ IsUserDefined b)
-> ExceptT Closure IO (Classifier (f a b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ExceptT Closure IO (Classifier_ IsUserDefined b)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO b
y'

classifyArrayLike ::
     (forall o x. Elems o '[x] -> Classifier_ o (f x))
  -> (f a -> Int)  -- ^ Get the length of the array
  -> (f a -> a)    -- ^ Get the first element (provided the array is not empty)
  -> f a -> ExceptT Closure IO (Classifier (f a))
classifyArrayLike :: (forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x))
-> (f a -> Int)
-> (f a -> a)
-> f a
-> ExceptT Closure IO (Classifier (f a))
classifyArrayLike forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x)
cc f a -> Int
getLen f a -> a
getFirst f a
x =
    if f a -> Int
getLen f a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Classifier (f a) -> ExceptT Closure IO (Classifier (f a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (f a) -> ExceptT Closure IO (Classifier (f a)))
-> Classifier (f a) -> ExceptT Closure IO (Classifier (f a))
forall a b. (a -> b) -> a -> b
$ Classifier_ IsUserDefined (f Void) -> Classifier (f a)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier_ IsUserDefined (f Void) -> Classifier (f a))
-> Classifier_ IsUserDefined (f Void) -> Classifier (f a)
forall a b. (a -> b) -> a -> b
$ Elems IsUserDefined '[Void] -> Classifier_ IsUserDefined (f Void)
forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x)
cc Elems IsUserDefined '[Void]
forall (o :: * -> *). Elems o '[Void]
ElemU
      else do
        let x' :: a
x' = f a -> a
getFirst f a
x
        Classifier (f a) -> Classifier (f a)
forall (o :: * -> *) b a. Classifier_ o b -> Classifier_ o a
mustBe (Classifier (f a) -> Classifier (f a))
-> (Classifier_ IsUserDefined a -> Classifier (f a))
-> Classifier_ IsUserDefined a
-> Classifier (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elems IsUserDefined '[a] -> Classifier (f a)
forall (o :: * -> *) x. Elems o '[x] -> Classifier_ o (f x)
cc (Elems IsUserDefined '[a] -> Classifier (f a))
-> (Classifier_ IsUserDefined a -> Elems IsUserDefined '[a])
-> Classifier_ IsUserDefined a
-> Classifier (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classifier_ IsUserDefined a -> Elems IsUserDefined '[a]
forall (o :: * -> *) a. Classifier_ o a -> Elems o '[a]
ElemK (Classifier_ IsUserDefined a -> Classifier (f a))
-> ExceptT Closure IO (Classifier_ IsUserDefined a)
-> ExceptT Closure IO (Classifier (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ExceptT Closure IO (Classifier_ IsUserDefined a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'

{-------------------------------------------------------------------------------
  Patterns for common shapes of 'Elems'

  This is mostly useful internally; we export these only for the benefit of the
  QuickCheck generator. Most other code can treat the all types uniformly.

  We distinguish between which elements are (K)nown and which (U)nknown
-------------------------------------------------------------------------------}

pattern ElemK :: Classifier_ o a -> Elems o '[a]
pattern $bElemK :: Classifier_ o a -> Elems o '[a]
$mElemK :: forall r (o :: * -> *) a.
Elems o '[a] -> (Classifier_ o a -> r) -> (Void# -> r) -> r
ElemK c = Elems (Elem c :* Nil)

pattern ElemU :: Elems o '[Void]
pattern $bElemU :: Elems o '[Void]
$mElemU :: forall r (o :: * -> *).
Elems o '[Void] -> (Void# -> r) -> (Void# -> r) -> r
ElemU = Elems (NoElem :* Nil)

pattern ElemKK :: Classifier_ o a -> Classifier_ o b -> Elems o '[a, b]
pattern $bElemKK :: Classifier_ o a -> Classifier_ o b -> Elems o '[a, b]
$mElemKK :: forall r (o :: * -> *) a b.
Elems o '[a, b]
-> (Classifier_ o a -> Classifier_ o b -> r) -> (Void# -> r) -> r
ElemKK ca cb = Elems (Elem ca :* Elem cb :* Nil)

pattern ElemUU :: Elems o '[Void, Void]
pattern $bElemUU :: Elems o '[Void, Void]
$mElemUU :: forall r (o :: * -> *).
Elems o '[Void, Void] -> (Void# -> r) -> (Void# -> r) -> r
ElemUU = Elems (NoElem :* NoElem :* Nil)

pattern ElemKU :: Classifier_ o a -> Elems o '[a, Void]
pattern $bElemKU :: Classifier_ o a -> Elems o '[a, Void]
$mElemKU :: forall r (o :: * -> *) a.
Elems o '[a, Void] -> (Classifier_ o a -> r) -> (Void# -> r) -> r
ElemKU c = Elems (Elem c :* NoElem :* Nil)

pattern ElemUK :: Classifier_ o b -> Elems o '[Void, b]
pattern $bElemUK :: Classifier_ o b -> Elems o '[Void, b]
$mElemUK :: forall r (o :: * -> *) b.
Elems o '[Void, b] -> (Classifier_ o b -> r) -> (Void# -> r) -> r
ElemUK c = Elems (NoElem :* Elem c :* Nil)

{-------------------------------------------------------------------------------
  Recognizing tuples
-------------------------------------------------------------------------------}

isTuple :: String -> Maybe (Some ValidSize)
isTuple :: String -> Maybe (Some ValidSize)
isTuple String
typ = do
    (Char
a, String
xs, Char
z) <- String -> Maybe (Char, String, Char)
forall a. [a] -> Maybe (a, [a], a)
dropEnds String
typ
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
xs Bool -> Bool -> Bool
&& Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'
    Int -> Maybe (Some ValidSize)
toValidSize (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

{-------------------------------------------------------------------------------
  Classify constructor arguments
-------------------------------------------------------------------------------}

-- | Bundle a value with its classifier
data Classified a = Classified (Classifier a) a

-- | Classify the arguments to the constructor
--
-- Additionally returns the constructor name itself.
fromUserDefined :: UserDefined -> (String, [Some Classified])
fromUserDefined :: UserDefined -> (String, [Some Classified])
fromUserDefined = \(UserDefined Any
x) -> IO (String, [Some Classified]) -> (String, [Some Classified])
forall a. IO a -> a
unsafePerformIO (IO (String, [Some Classified]) -> (String, [Some Classified]))
-> IO (String, [Some Classified]) -> (String, [Some Classified])
forall a b. (a -> b) -> a -> b
$ Any -> IO (String, [Some Classified])
forall x. x -> IO (String, [Some Classified])
go Any
x
  where
    go :: x -> IO (String, [Some Classified])
    go :: x -> IO (String, [Some Classified])
go x
x = do
        FlatClosure
closure <- Box -> IO FlatClosure
getBoxedClosureData (x -> Box
forall a. a -> Box
asBox x
x)
        case FlatClosure
closure of
          ConstrClosure {String
name :: FlatClosure -> String
name :: String
name, [Box]
ptrArgs :: FlatClosure -> [Box]
ptrArgs :: [Box]
ptrArgs} ->
            (String
name,) ([Some Classified] -> (String, [Some Classified]))
-> IO [Some Classified] -> IO (String, [Some Classified])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Some Classified] -> [Box] -> IO [Some Classified]
goArgs [] [Box]
ptrArgs
          FlatClosure
_otherwise ->
            String -> IO (String, [Some Classified])
forall a. HasCallStack => String -> a
error (String -> IO (String, [Some Classified]))
-> String -> IO (String, [Some Classified])
forall a b. (a -> b) -> a -> b
$ String
"elimUserDefined: unexpected closure: "
                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ FlatClosure -> String
forall a. Show a => a -> String
show FlatClosure
closure

    goArgs :: [Some Classified] -> [Box] -> IO [Some Classified]
    goArgs :: [Some Classified] -> [Box] -> IO [Some Classified]
goArgs [Some Classified]
acc []         = [Some Classified] -> IO [Some Classified]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Some Classified] -> [Some Classified]
forall a. [a] -> [a]
reverse [Some Classified]
acc)
    goArgs [Some Classified]
acc (Box Any
b:[Box]
bs) = do
        Either Closure (Classifier Any)
mc <- ExceptT Closure IO (Classifier Any)
-> IO (Either Closure (Classifier Any))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Closure IO (Classifier Any)
 -> IO (Either Closure (Classifier Any)))
-> ExceptT Closure IO (Classifier Any)
-> IO (Either Closure (Classifier Any))
forall a b. (a -> b) -> a -> b
$ Any -> ExceptT Closure IO (Classifier Any)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO Any
b
        case Either Closure (Classifier Any)
mc of
          Right Classifier Any
c -> [Some Classified] -> [Box] -> IO [Some Classified]
goArgs (Classified Any -> Some Classified
forall k (f :: k -> *) (a :: k). f a -> Some f
Some (Classifier Any -> Any -> Classified Any
forall a. Classifier a -> a -> Classified a
Classified Classifier Any
c (Any -> Any
forall a b. a -> b
unsafeCoerce Any
b)) Some Classified -> [Some Classified] -> [Some Classified]
forall a. a -> [a] -> [a]
: [Some Classified]
acc) [Box]
bs
          Left  Closure
_ -> [Some Classified] -> [Box] -> IO [Some Classified]
goArgs                                         [Some Classified]
acc  [Box]
bs

{-------------------------------------------------------------------------------
  Show

  Showing values is mutually recursive with classification: when we show a
  value classified as @UserDefined@, we recursively classify the nested values
  /when/ we show the value.
-------------------------------------------------------------------------------}

-- | Show any value
--
-- This shows any value, as long as it's not unlifted. The result should be
-- equal to show instances, with the following caveats:
--
-- * User-defined types (types not explicitly known to this library) with a
--   /custom/ Show instance will still be showable, but the result will be
--   what the /derived/ show instance would have done.
-- * Record field names are not known at runtime, so they are not shown.
-- * UNPACKed data is not visible to this library (if you compile with @-O0@
--   @ghc@ will not unpack data, so that might be a workaround if necessary).
--
-- If classification fails, we show the actual closure.
anythingToString :: forall a. a -> String
anythingToString :: a -> String
anythingToString a
x =
    case a -> Either Closure (Classifier a)
forall a. a -> Either Closure (Classifier a)
classify a
x of
      Left  Closure
closure    -> Closure -> String
forall a. Show a => a -> String
show Closure
closure
      Right Classifier a
classifier -> case Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
canShowClassified Classifier a
classifier of
                            Dict Show a
Dict -> a -> String
forall a. Show a => a -> String
show a
x

deriving instance Show (Some Classified)

instance Show (Classified a) where
  showsPrec :: Int -> Classified a -> String -> String
showsPrec Int
p (Classified Classifier a
c a
x) = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
      case Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
canShowClassified Classifier a
c of
        Dict Show a
Dict ->
            String -> String -> String
showString String
"Classified "
          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Classifier a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Classifier a
c
          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" "
          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 a
x

-- | Show the classified value (without the classifier)
showClassifiedValue :: Int -> Classified a -> ShowS
showClassifiedValue :: Int -> Classified a -> String -> String
showClassifiedValue Int
p (Classified Classifier a
c a
x) =
    case Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
canShowClassified Classifier a
c of
      Dict Show a
Dict -> Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
p a
x

canShowClassified :: Classifier a -> Dict Show a
canShowClassified :: Classifier a -> Dict Show a
canShowClassified = (forall a. IsUserDefined a -> Dict Show a)
-> forall a. Classifier a -> Dict Show a
forall (o :: * -> *).
(forall a. o a -> Dict Show a)
-> forall a. Classifier_ o a -> Dict Show a
canShowClassified_ forall a. IsUserDefined a -> Dict Show a
showOther
  where
    showOther :: IsUserDefined a -> Dict Show a
    showOther :: IsUserDefined a -> Dict Show a
showOther (IsUserDefined UserDefined
_) = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

canShowPrim :: PrimClassifier a -> Dict Show a
canShowPrim :: PrimClassifier a -> Dict Show a
canShowPrim = PrimClassifier a -> Dict Show a
forall (c :: * -> Constraint) a.
PrimSatisfies c =>
PrimClassifier a -> Dict c a
primSatisfies

canShowClassified_ :: forall o.
     (forall a. o a -> Dict Show a)
  -> (forall a. Classifier_ o a -> Dict Show a)
canShowClassified_ :: (forall a. o a -> Dict Show a)
-> forall a. Classifier_ o a -> Dict Show a
canShowClassified_ = (forall a. o a -> Dict Show a) -> Classifier_ o a -> Dict Show a
forall (c :: * -> Constraint) (o :: * -> *).
(ClassifiedSatisfies c, c Void) =>
(forall a. o a -> Dict c a)
-> forall a. Classifier_ o a -> Dict c a
classifiedSatisfies

instance Show UserDefined where
  showsPrec :: Int -> UserDefined -> String -> String
showsPrec Int
p UserDefined
x =
      case [Some Classified]
args of
        [] -> String -> String -> String
showString String
constrName
        [Some Classified]
xs -> Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
            ((String -> String) -> String -> String)
-> ([Some Classified] -> String -> String)
-> [Some Classified]
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
showString String
constrName (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
            ((String -> String) -> String -> String)
-> ([Some Classified] -> String -> String)
-> [Some Classified]
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) String -> String
forall a. a -> a
id
            ([String -> String] -> String -> String)
-> ([Some Classified] -> [String -> String])
-> [Some Classified]
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Some Classified -> String -> String)
-> [Some Classified] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Some Classified a
x') -> String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Classified a -> String -> String
forall a. Int -> Classified a -> String -> String
showClassifiedValue Int
11 Classified a
x')
            ([Some Classified] -> String -> String)
-> [Some Classified] -> String -> String
forall a b. (a -> b) -> a -> b
$ [Some Classified]
xs
    where
      (String
constrName, [Some Classified]
args) = UserDefined -> (String, [Some Classified])
fromUserDefined UserDefined
x