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

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

module Debug.RecoverRTTI.Classify (
    -- * Classification
    classify
  , classified
  , fromUserDefined
    -- * Showing values
  , anythingToString
  , canShowClassified
  ) 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 GHC.Exts.Heap (Closure)
import GHC.Real
import GHC.Stack
import System.IO.Unsafe (unsafePerformIO)
import Unsafe.Coerce (unsafeCoerce)

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.IntMap                 as IntMap
import qualified Data.Map                    as Map
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as Set
import qualified Data.Tree                   as Tree
import qualified Data.Vector                 as Vector.Boxed

import Debug.RecoverRTTI.Classifier
import Debug.RecoverRTTI.Constr
import Debug.RecoverRTTI.FlatClosure
import Debug.RecoverRTTI.Modules
import Debug.RecoverRTTI.Tuple
import Debug.RecoverRTTI.TypeLevel
import Debug.RecoverRTTI.UserDefined
import Debug.RecoverRTTI.Util

{-------------------------------------------------------------------------------
  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).
SingI 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 Bool -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Bool
C_Bool
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Bool -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Bool
C_Bool
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Char -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Char
C_Char
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Double -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Double
C_Double
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Float -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Float
C_Float
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Int -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Int
C_Int
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Ordering -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Ordering
C_Ordering
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Ordering -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Ordering
C_Ordering
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Ordering -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Ordering
C_Ordering
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Word -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Word
C_Word

      -- GHC.Tuple
      (KnownModule 'PkgGhcPrim -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 () -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier ()
C_Unit

      -- GHC.Int
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Int8 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Int8
C_Int8
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Int16 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Int16
C_Int16
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Int32 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Int32
C_Int32
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Int64 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Int64
C_Int64

      -- GHC.Integer
      (KnownModule 'PkgIntegerWiredIn -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Integer -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Integer
C_Integer
      (KnownModule 'PkgIntegerWiredIn -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Integer -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Integer
C_Integer
      (KnownModule 'PkgIntegerWiredIn -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Integer -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Integer
C_Integer
      (KnownModule 'PkgGhcBignum -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Integer -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Integer
C_Integer
      (KnownModule 'PkgGhcBignum -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Integer -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Integer
C_Integer
      (KnownModule 'PkgGhcBignum -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Integer -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Integer
C_Integer

      -- GHC.Word
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Word8 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Word8
C_Word8
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Word16 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Word16
C_Word16
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Word32 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Word32
C_Word32
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Word64 -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Word64
C_Word64

      --
      -- String types
      --

      -- bytestring
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 ByteString -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier ByteString
C_BS_Strict
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 ByteString -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier ByteString
C_BS_Lazy
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 ByteString -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier ByteString
C_BS_Lazy
      (KnownModule 'PkgByteString -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 ShortByteString -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier ShortByteString
C_BS_Short

      -- text
      (KnownModule 'PkgText -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Text -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Text
C_Text_Strict
      (KnownModule 'PkgText -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Text -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Text
C_Text_Lazy
      (KnownModule 'PkgText -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Text -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Text
C_Text_Lazy

      --
      -- Aeson
      --

      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Value -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Value -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Value -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Value -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Value -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Value
C_Value
      (KnownModule 'PkgAeson -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 Value -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier Value
C_Value

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

      -- Maybe
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcMaybe -> Just String
"Nothing") ->
        Classifier (Maybe Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Maybe Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcMaybe -> Just String
"Just") ->
        Classifier (Maybe Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Maybe Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
DataEither -> Just String
"Left") ->
        Classifier (Either Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Either Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
DataEither -> Just String
"Right") ->
        Classifier (Either Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Either Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
"[]") ->
        Classifier [Any] -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier [Any] -> Classifier a)
-> ExceptT Closure IO (Classifier [Any])
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Any] -> ExceptT Closure IO (Classifier [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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgGhcPrim
GhcTypes -> Just String
":") ->
        Classifier [Any] -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier [Any] -> Classifier a)
-> ExceptT Closure IO (Classifier [Any])
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Any] -> ExceptT Closure IO (Classifier [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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgBase
GhcReal -> Just String
":%") ->
        Classifier (Ratio Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Ratio Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSetInternal -> Just String
"Tip") ->
        Classifier (Set Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Set Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSetInternal -> Just String
"Bin") ->
        Classifier (Set Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Set Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataMapInternal -> Just String
"Tip") ->
        Classifier (Map Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Map Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataMapInternal -> Just String
"Bin") ->
        Classifier (Map Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Map Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI 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 IntSet -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier IntSet -> Classifier a)
-> Classifier IntSet -> Classifier a
forall a b. (a -> b) -> a -> b
$ Classifier IntSet
C_IntSet
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 IntSet -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier IntSet -> Classifier a)
-> Classifier IntSet -> Classifier a
forall a b. (a -> b) -> a -> b
$ Classifier IntSet
C_IntSet
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 IntSet -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier IntSet -> Classifier a)
-> Classifier IntSet -> Classifier a
forall a b. (a -> b) -> a -> b
$ Classifier IntSet
C_IntSet

      -- IntMap
      (KnownModule 'PkgContainers -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntMapInternal -> Just String
"Nil") ->
        Classifier (IntMap Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (IntMap Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntMapInternal -> Just String
"Tip") ->
        Classifier (IntMap Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (IntMap Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataIntMapInternal -> Just String
"Bin") ->
        Classifier (IntMap Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (IntMap Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSequenceInternal -> Just String
"EmptyT") ->
        Classifier (Seq Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Seq Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSequenceInternal -> Just String
"Single") ->
        Classifier (Seq Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Seq Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataSequenceInternal -> Just String
"Deep") ->
        Classifier (Seq Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Seq Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgContainers
DataTree -> Just String
"Node") ->
        Classifier (Tree Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Tree Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
inKnownModuleNested KnownModule 'PkgGhcPrim
GhcTuple -> Just (
            String -> Maybe (Some ValidSize)
isTuple       -> Just (Some validSize :: ValidSize a
validSize@(ValidSize Sing a
sz forall r. TooBig a -> r
_))
          , Sing a -> [Box] -> Maybe (VerifiedSize a Box)
forall (n :: Nat) a. Sing n -> [a] -> Maybe (VerifiedSize n a)
verifySize Sing 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 (WrappedTuple xs) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (WrappedTuple xs) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Empty") ->
        Classifier (HashMap Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"BitmapIndexed") ->
        Classifier (HashMap Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Leaf") ->
        Classifier (HashMap Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Full") ->
        Classifier (HashMap Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternal -> Just String
"Collision") ->
        Classifier (HashMap Any Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap Any Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (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).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgUnorderedContainers
DataHashMapInternalArray -> Just String
"Array") ->
        Classifier (Tree Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Tree Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (Tree Any))
-> ExceptT Closure IO (Classifier a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Any -> ExceptT Closure IO (Classifier (Tree Any))
forall a. Array a -> ExceptT Closure IO (Classifier (Tree a))
classifyHMArray (a -> Array Any
forall a b. a -> b
unsafeCoerce a
x)

      -- Boxed vectors
      (KnownModule 'PkgVector -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule 'PkgVector
DataVector -> Just String
"Vector") ->
        Classifier (Vector Any) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Vector Any) -> Classifier a)
-> ExceptT Closure IO (Classifier (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 (Vector Any))
forall a. Vector a -> ExceptT Closure IO (Classifier (Vector a))
classifyVectorBoxed (a -> Vector Any
forall a b. a -> b
unsafeCoerce a
x)

      --
      -- Reference cells
      --

      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 SomeSTRef -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier SomeSTRef
C_STRef
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 SomeMVar -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier SomeMVar
C_MVar
      (KnownModule 'PkgBase -> FlatClosure -> Maybe String
forall (pkg :: KnownPkg).
SingI 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 SomeTVar -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier 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 SomeFun -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe Classifier SomeFun
C_Fun

      --
      -- User defined
      --

      ConstrClosure {String
pkg :: FlatClosure -> String
pkg :: String
pkg, String
modl :: FlatClosure -> String
modl :: String
modl, String
name :: FlatClosure -> String
name :: String
name} ->
        Constr String
-> (forall (c :: Constr Symbol).
    Sing c -> ExceptT Closure IO (Classifier a))
-> ExceptT Closure IO (Classifier a)
forall r.
Constr String -> (forall (c :: Constr Symbol). Sing c -> r) -> r
elimKnownConstr (String -> String -> String -> Constr String
forall a. a -> a -> a -> Constr a
Constr String
pkg String
modl String
name) ((forall (c :: Constr Symbol).
  Sing c -> ExceptT Closure IO (Classifier a))
 -> ExceptT Closure IO (Classifier a))
-> (forall (c :: Constr Symbol).
    Sing c -> ExceptT Closure IO (Classifier a))
-> ExceptT Closure IO (Classifier a)
forall a b. (a -> b) -> a -> b
$ \Sing c
p ->
        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 (UserDefined c) -> Classifier a
forall b a. Classifier b -> Classifier a
mustBe (Sing c -> Classifier (UserDefined c)
forall (c :: Constr Symbol). Sing c -> Classifier (UserDefined c)
C_Custom Sing c
p)

      --
      -- 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 b -> Classifier a
mustBe :: Classifier b -> Classifier a
mustBe = Classifier b -> Classifier 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 Maybe a
x =
    case Maybe a
x of
      Maybe a
Nothing -> Classifier (Maybe a) -> ExceptT Closure IO (Classifier (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Maybe a) -> ExceptT Closure IO (Classifier (Maybe a)))
-> Classifier (Maybe a)
-> ExceptT Closure IO (Classifier (Maybe a))
forall a b. (a -> b) -> a -> b
$ Classifier (Maybe Void) -> Classifier (Maybe a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Maybe Void) -> Classifier (Maybe a))
-> Classifier (Maybe Void) -> Classifier (Maybe a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier (Maybe Void)
forall a. MaybeF Classified a -> Classifier (Maybe a)
C_Maybe MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      Just a
x' -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Maybe a) -> ExceptT Closure IO (Classifier (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Maybe a) -> ExceptT Closure IO (Classifier (Maybe a)))
-> Classifier (Maybe a)
-> ExceptT Closure IO (Classifier (Maybe a))
forall a b. (a -> b) -> a -> b
$ Classifier (Maybe a) -> Classifier (Maybe a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Maybe a) -> Classifier (Maybe a))
-> Classifier (Maybe a) -> Classifier (Maybe a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier (Maybe a)
forall a. MaybeF Classified a -> Classifier (Maybe a)
C_Maybe (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

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' -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Either a b)
-> ExceptT Closure IO (Classifier (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Either a b)
 -> ExceptT Closure IO (Classifier (Either a b)))
-> Classifier (Either a b)
-> ExceptT Closure IO (Classifier (Either a b))
forall a b. (a -> b) -> a -> b
$ Classifier (Either a Void) -> Classifier (Either a b)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Either a Void) -> Classifier (Either a b))
-> Classifier (Either a Void) -> Classifier (Either a b)
forall a b. (a -> b) -> a -> b
$ EitherF Classified a Void -> Classifier (Either a Void)
forall a a. EitherF Classified a a -> Classifier (Either a a)
C_Either (Classified a -> EitherF Classified a Void
forall (f :: * -> *) a. f a -> EitherF f a Void
FLeft (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))
      Right b
y' -> do
        Classifier b
cy <- b -> ExceptT Closure IO (Classifier b)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO b
y'
        Classifier (Either a b)
-> ExceptT Closure IO (Classifier (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Either a b)
 -> ExceptT Closure IO (Classifier (Either a b)))
-> Classifier (Either a b)
-> ExceptT Closure IO (Classifier (Either a b))
forall a b. (a -> b) -> a -> b
$ Classifier (Either Void b) -> Classifier (Either a b)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Either Void b) -> Classifier (Either a b))
-> Classifier (Either Void b) -> Classifier (Either a b)
forall a b. (a -> b) -> a -> b
$ EitherF Classified Void b -> Classifier (Either Void b)
forall a a. EitherF Classified a a -> Classifier (Either a a)
C_Either (Classified b -> EitherF Classified Void b
forall (f :: * -> *) b. f b -> EitherF f Void b
FRight (Classifier b -> b -> Classified b
forall a. Classifier a -> a -> Classified a
Classified Classifier b
cy b
y'))

classifyList ::
     [a]
  -> ExceptT Closure IO (Classifier [a])
classifyList :: [a] -> ExceptT Closure IO (Classifier [a])
classifyList [a]
x =
    case [a]
x of
      []   -> 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 [Void] -> Classifier [a]
forall b a. Classifier b -> Classifier a
mustBe (Classifier [Void] -> Classifier [a])
-> Classifier [Void] -> Classifier [a]
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier [Void]
forall a. MaybeF Classified a -> Classifier [a]
C_List MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      a
x':[a]
_ -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        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
$ case Classifier a
cx of
          Classifier a
C_Char     -> Classifier String -> Classifier String
forall b a. Classifier b -> Classifier a
mustBe (Classifier String -> Classifier String)
-> Classifier String -> Classifier String
forall a b. (a -> b) -> a -> b
$ Classifier String
C_String
          Classifier a
_otherwise -> Classifier [a] -> Classifier [a]
forall b a. Classifier b -> Classifier a
mustBe (Classifier [a] -> Classifier [a])
-> Classifier [a] -> Classifier [a]
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier [a]
forall a. MaybeF Classified a -> Classifier [a]
C_List (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

classifyRatio ::
     Ratio a
  -> ExceptT Closure IO (Classifier (Ratio a))
classifyRatio :: Ratio a -> ExceptT Closure IO (Classifier (Ratio a))
classifyRatio (a
x' :% a
_) = do
    Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
    Classifier (Ratio a) -> ExceptT Closure IO (Classifier (Ratio a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Ratio a) -> ExceptT Closure IO (Classifier (Ratio a)))
-> Classifier (Ratio a)
-> ExceptT Closure IO (Classifier (Ratio a))
forall a b. (a -> b) -> a -> b
$ Classifier (Ratio a) -> Classifier (Ratio a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Ratio a) -> Classifier (Ratio a))
-> Classifier (Ratio a) -> Classifier (Ratio a)
forall a b. (a -> b) -> a -> b
$ Classified a -> Classifier (Ratio a)
forall a. Classified a -> Classifier (Ratio a)
C_Ratio (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x')

classifySet ::
     Set a
  -> ExceptT Closure IO (Classifier (Set a))
classifySet :: Set a -> ExceptT Closure IO (Classifier (Set a))
classifySet Set a
x =
    case Set a -> Maybe a
forall a. Set a -> Maybe a
Set.lookupMin Set a
x of
      Maybe a
Nothing -> Classifier (Set a) -> ExceptT Closure IO (Classifier (Set a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Set a) -> ExceptT Closure IO (Classifier (Set a)))
-> Classifier (Set a) -> ExceptT Closure IO (Classifier (Set a))
forall a b. (a -> b) -> a -> b
$ Classifier (Set Void) -> Classifier (Set a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Set Void) -> Classifier (Set a))
-> Classifier (Set Void) -> Classifier (Set a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier (Set Void)
forall a. MaybeF Classified a -> Classifier (Set a)
C_Set MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      Just a
x' -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Set a) -> ExceptT Closure IO (Classifier (Set a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Set a) -> ExceptT Closure IO (Classifier (Set a)))
-> Classifier (Set a) -> ExceptT Closure IO (Classifier (Set a))
forall a b. (a -> b) -> a -> b
$ Classifier (Set a) -> Classifier (Set a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Set a) -> Classifier (Set a))
-> Classifier (Set a) -> Classifier (Set a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier (Set a)
forall a. MaybeF Classified a -> Classifier (Set a)
C_Set (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

classifyMap ::
     Map a b
  -> ExceptT Closure IO (Classifier (Map a b))
classifyMap :: Map a b -> ExceptT Closure IO (Classifier (Map a b))
classifyMap Map a b
x =
    case Map a b -> Maybe (a, b)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMin Map a b
x of
      Maybe (a, b)
Nothing       -> Classifier (Map a b) -> ExceptT Closure IO (Classifier (Map a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Map a b) -> ExceptT Closure IO (Classifier (Map a b)))
-> Classifier (Map a b)
-> ExceptT Closure IO (Classifier (Map a b))
forall a b. (a -> b) -> a -> b
$ Classifier (Map Void Void) -> Classifier (Map a b)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Map Void Void) -> Classifier (Map a b))
-> Classifier (Map Void Void) -> Classifier (Map a b)
forall a b. (a -> b) -> a -> b
$ MaybePairF Classified Void Void -> Classifier (Map Void Void)
forall a a. MaybePairF Classified a a -> Classifier (Map a a)
C_Map MaybePairF Classified Void Void
forall (f :: * -> *). MaybePairF f Void Void
FNothingPair
      Just (a
x', b
y') -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier b
cy <- b -> ExceptT Closure IO (Classifier b)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO b
y'
        Classifier (Map a b) -> ExceptT Closure IO (Classifier (Map a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Map a b) -> ExceptT Closure IO (Classifier (Map a b)))
-> Classifier (Map a b)
-> ExceptT Closure IO (Classifier (Map a b))
forall a b. (a -> b) -> a -> b
$ Classifier (Map a b) -> Classifier (Map a b)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Map a b) -> Classifier (Map a b))
-> Classifier (Map a b) -> Classifier (Map a b)
forall a b. (a -> b) -> a -> b
$ MaybePairF Classified a b -> Classifier (Map a b)
forall a a. MaybePairF Classified a a -> Classifier (Map a a)
C_Map (Classified a -> Classified b -> MaybePairF Classified a b
forall (f :: * -> *) a b. f a -> f b -> MaybePairF f a b
FJustPair (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x') (Classifier b -> b -> Classified b
forall a. Classifier a -> a -> Classified a
Classified Classifier b
cy b
y'))

classifyIntMap ::
     IntMap a
  -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap :: IntMap a -> ExceptT Closure IO (Classifier (IntMap a))
classifyIntMap IntMap a
x =
    case IntMap a -> Maybe (a, IntMap a)
forall a. IntMap a -> Maybe (a, IntMap a)
IntMap.minView IntMap a
x of
      Maybe (a, IntMap a)
Nothing      -> Classifier (IntMap a) -> ExceptT Closure IO (Classifier (IntMap a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (IntMap a)
 -> ExceptT Closure IO (Classifier (IntMap a)))
-> Classifier (IntMap a)
-> ExceptT Closure IO (Classifier (IntMap a))
forall a b. (a -> b) -> a -> b
$ Classifier (IntMap Void) -> Classifier (IntMap a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (IntMap Void) -> Classifier (IntMap a))
-> Classifier (IntMap Void) -> Classifier (IntMap a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier (IntMap Void)
forall a. MaybeF Classified a -> Classifier (IntMap a)
C_IntMap MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      Just (a
x', IntMap a
_) -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (IntMap a) -> ExceptT Closure IO (Classifier (IntMap a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (IntMap a)
 -> ExceptT Closure IO (Classifier (IntMap a)))
-> Classifier (IntMap a)
-> ExceptT Closure IO (Classifier (IntMap a))
forall a b. (a -> b) -> a -> b
$ Classifier (IntMap a) -> Classifier (IntMap a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (IntMap a) -> Classifier (IntMap a))
-> Classifier (IntMap a) -> Classifier (IntMap a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier (IntMap a)
forall a. MaybeF Classified a -> Classifier (IntMap a)
C_IntMap (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

classifySequence ::
     Seq a
  -> ExceptT Closure IO (Classifier (Seq a))
classifySequence :: Seq a -> ExceptT Closure IO (Classifier (Seq a))
classifySequence Seq a
x =
    case Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
x of
      ViewL a
Seq.EmptyL  -> Classifier (Seq a) -> ExceptT Closure IO (Classifier (Seq a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Seq a) -> ExceptT Closure IO (Classifier (Seq a)))
-> Classifier (Seq a) -> ExceptT Closure IO (Classifier (Seq a))
forall a b. (a -> b) -> a -> b
$ Classifier (Seq Void) -> Classifier (Seq a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Seq Void) -> Classifier (Seq a))
-> Classifier (Seq Void) -> Classifier (Seq a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier (Seq Void)
forall a. MaybeF Classified a -> Classifier (Seq a)
C_Sequence MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      a
x' Seq.:< Seq a
_ -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Seq a) -> ExceptT Closure IO (Classifier (Seq a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Seq a) -> ExceptT Closure IO (Classifier (Seq a)))
-> Classifier (Seq a) -> ExceptT Closure IO (Classifier (Seq a))
forall a b. (a -> b) -> a -> b
$ Classifier (Seq a) -> Classifier (Seq a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Seq a) -> Classifier (Seq a))
-> Classifier (Seq a) -> Classifier (Seq a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier (Seq a)
forall a. MaybeF Classified a -> Classifier (Seq a)
C_Sequence (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

classifyTree ::
     Tree a
  -> ExceptT Closure IO (Classifier (Tree a))
classifyTree :: Tree a -> ExceptT Closure IO (Classifier (Tree a))
classifyTree Tree a
x =
    case Tree a
x of
      Tree.Node a
x' Forest a
_ -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a)))
-> Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a))
forall a b. (a -> b) -> a -> b
$ Classifier (Tree a) -> Classifier (Tree a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Tree a) -> Classifier (Tree a))
-> Classifier (Tree a) -> Classifier (Tree a)
forall a b. (a -> b) -> a -> b
$ Classified a -> Classifier (Tree a)
forall a. Classified a -> Classifier (Tree a)
C_Tree (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx 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 HashMap a b
x =
    case HashMap a b -> [(a, b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap a b
x of
      []           -> Classifier (HashMap a b)
-> ExceptT Closure IO (Classifier (HashMap a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (HashMap a b)
 -> ExceptT Closure IO (Classifier (HashMap a b)))
-> Classifier (HashMap a b)
-> ExceptT Closure IO (Classifier (HashMap a b))
forall a b. (a -> b) -> a -> b
$ Classifier (HashMap Void Void) -> Classifier (HashMap a b)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap Void Void) -> Classifier (HashMap a b))
-> Classifier (HashMap Void Void) -> Classifier (HashMap a b)
forall a b. (a -> b) -> a -> b
$ MaybePairF Classified Void Void -> Classifier (HashMap Void Void)
forall a a. MaybePairF Classified a a -> Classifier (HashMap a a)
C_HashMap MaybePairF Classified Void Void
forall (f :: * -> *). MaybePairF f Void Void
FNothingPair
      ((a
x', b
y'):[(a, b)]
_) -> do
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier b
cy <- b -> ExceptT Closure IO (Classifier b)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO b
y'
        Classifier (HashMap a b)
-> ExceptT Closure IO (Classifier (HashMap a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (HashMap a b)
 -> ExceptT Closure IO (Classifier (HashMap a b)))
-> Classifier (HashMap a b)
-> ExceptT Closure IO (Classifier (HashMap a b))
forall a b. (a -> b) -> a -> b
$ case Classifier b
cy of
          Classifier b
C_Unit     -> Classifier (HashSet a) -> Classifier (HashMap a ())
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashSet a) -> Classifier (HashMap a ()))
-> Classifier (HashSet a) -> Classifier (HashMap a ())
forall a b. (a -> b) -> a -> b
$ Classified a -> Classifier (HashSet a)
forall a. Classified a -> Classifier (HashSet a)
C_HashSet (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x')
          Classifier b
_otherwise -> Classifier (HashMap a b) -> Classifier (HashMap a b)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (HashMap a b) -> Classifier (HashMap a b))
-> Classifier (HashMap a b) -> Classifier (HashMap a b)
forall a b. (a -> b) -> a -> b
$ MaybePairF Classified a b -> Classifier (HashMap a b)
forall a a. MaybePairF Classified a a -> Classifier (HashMap a a)
C_HashMap (Classified a -> Classified b -> MaybePairF Classified a b
forall (f :: * -> *) a b. f a -> f b -> MaybePairF f a b
FJustPair (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x') (Classifier b -> b -> Classified b
forall a. Classifier a -> a -> Classified a
Classified Classifier b
cy b
y'))

classifyHMArray ::
     HashMap.Array a
  -> ExceptT Closure IO (Classifier (Tree a))
classifyHMArray :: Array a -> ExceptT Closure IO (Classifier (Tree a))
classifyHMArray Array a
x =
    if Array a -> Int
forall a. Array a -> Int
HashMap.Array.length Array a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a)))
-> Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a))
forall a b. (a -> b) -> a -> b
$ Classifier (Array Void) -> Classifier (Tree a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Array Void) -> Classifier (Tree a))
-> Classifier (Array Void) -> Classifier (Tree a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier (Array Void)
forall a. MaybeF Classified a -> Classifier (Array a)
C_HM_Array MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      else do
        let x' :: a
x' = Array a -> Int -> a
forall a. Array a -> Int -> a
HashMap.Array.index Array a
x Int
0
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a)))
-> Classifier (Tree a) -> ExceptT Closure IO (Classifier (Tree a))
forall a b. (a -> b) -> a -> b
$ Classifier (Array a) -> Classifier (Tree a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Array a) -> Classifier (Tree a))
-> Classifier (Array a) -> Classifier (Tree a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier (Array a)
forall a. MaybeF Classified a -> Classifier (Array a)
C_HM_Array (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

classifyVectorBoxed ::
     Vector.Boxed.Vector a
  -> ExceptT Closure IO (Classifier (Vector.Boxed.Vector a))
classifyVectorBoxed :: Vector a -> ExceptT Closure IO (Classifier (Vector a))
classifyVectorBoxed Vector a
x =
    if Vector a -> Int
forall a. Vector a -> Int
Vector.Boxed.length Vector a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Classifier (Vector a) -> ExceptT Closure IO (Classifier (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Vector a)
 -> ExceptT Closure IO (Classifier (Vector a)))
-> Classifier (Vector a)
-> ExceptT Closure IO (Classifier (Vector a))
forall a b. (a -> b) -> a -> b
$ Classifier (Vector Void) -> Classifier (Vector a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Vector Void) -> Classifier (Vector a))
-> Classifier (Vector Void) -> Classifier (Vector a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified Void -> Classifier (Vector Void)
forall a. MaybeF Classified a -> Classifier (Vector a)
C_Vector_Boxed MaybeF Classified Void
forall (f :: * -> *). MaybeF f Void
FNothing
      else do
        let x' :: a
x' = Vector a -> a
forall a. Vector a -> a
Vector.Boxed.head Vector a
x
        Classifier a
cx <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO a
x'
        Classifier (Vector a) -> ExceptT Closure IO (Classifier (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Classifier (Vector a)
 -> ExceptT Closure IO (Classifier (Vector a)))
-> Classifier (Vector a)
-> ExceptT Closure IO (Classifier (Vector a))
forall a b. (a -> b) -> a -> b
$ Classifier (Vector a) -> Classifier (Vector a)
forall b a. Classifier b -> Classifier a
mustBe (Classifier (Vector a) -> Classifier (Vector a))
-> Classifier (Vector a) -> Classifier (Vector a)
forall a b. (a -> b) -> a -> b
$ MaybeF Classified a -> Classifier (Vector a)
forall a. MaybeF Classified a -> Classifier (Vector a)
C_Vector_Boxed (Classified a -> MaybeF Classified a
forall (f :: * -> *) a. f a -> MaybeF f a
FJust (Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x'))

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 Classified xs
cs <- NP (ExceptT Closure IO :.: Classified) xs
-> ExceptT Closure IO (NP Classified 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) Classified a)
-> NP (K Box) xs -> NP (ExceptT Closure IO :.: Classified) 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) Classified 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
$ Classifiers xs -> Classifier (WrappedTuple xs)
forall (xs :: [*]).
(SListI xs, IsValidSize (Length xs)) =>
Classifiers xs -> Classifier (WrappedTuple xs)
C_Tuple (NP Classified xs -> Classifiers xs
forall (xs :: [*]). NP Classified xs -> Classifiers xs
Classifiers NP Classified xs
cs)
  where
    aux :: K Box a -> (ExceptT Closure IO :.: Classified) a
    aux :: K Box a -> (:.:) (ExceptT Closure IO) Classified a
aux (K (Box Any
x)) = ExceptT Closure IO (Classified a)
-> (:.:) (ExceptT Closure IO) Classified a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (ExceptT Closure IO (Classified a)
 -> (:.:) (ExceptT Closure IO) Classified a)
-> ExceptT Closure IO (Classified a)
-> (:.:) (ExceptT Closure IO) Classified a
forall a b. (a -> b) -> a -> b
$ do
        Classifier a
c <- a -> ExceptT Closure IO (Classifier a)
forall a. a -> ExceptT Closure IO (Classifier a)
classifyIO (Any -> a
forall a b. a -> b
unsafeCoerce Any
x)
        Classified a -> ExceptT Closure IO (Classified a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Classified a -> ExceptT Closure IO (Classified a))
-> Classified a -> ExceptT Closure IO (Classified a)
forall a b. (a -> b) -> a -> b
$ Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
c (Any -> a
forall a b. a -> b
unsafeCoerce Any
x)

{-------------------------------------------------------------------------------
  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)

{-------------------------------------------------------------------------------
  Classified values
-------------------------------------------------------------------------------}

classified :: a -> Either Closure (Classified a)
classified :: a -> Either Closure (Classified a)
classified a
x = (\Classifier a
cx -> Classifier a -> a -> Classified a
forall a. Classifier a -> a -> Classified a
Classified Classifier a
cx a
x) (Classifier a -> Classified a)
-> Either Closure (Classifier a) -> Either Closure (Classified a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Either Closure (Classifier a)
forall a. a -> Either Closure (Classifier a)
classify a
x

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

-- | Classify the arguments to the constructor
--
-- We only look at pointers and ignore any @UNPACK@ed data. Arguments we cannot
-- classify (like unlifted arguments) will be ignored.
fromUserDefined :: forall c.
     (HasCallStack, KnownConstr c)
  => UserDefined c -> [Some Classified]
fromUserDefined :: UserDefined c -> [Some Classified]
fromUserDefined = \(UserDefined Any
x) -> IO [Some Classified] -> [Some Classified]
forall a. IO a -> a
unsafePerformIO (IO [Some Classified] -> [Some Classified])
-> IO [Some Classified] -> [Some Classified]
forall a b. (a -> b) -> a -> b
$ Any -> IO [Some Classified]
forall x. x -> IO [Some Classified]
go Any
x
  where
    go :: x -> IO [Some Classified]
    go :: x -> IO [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
pkg :: String
pkg :: FlatClosure -> String
pkg, String
modl :: String
modl :: FlatClosure -> String
modl, String
name :: String
name :: FlatClosure -> String
name, [Box]
ptrArgs :: FlatClosure -> [Box]
ptrArgs :: [Box]
ptrArgs} -> do
            let expected, actual :: Constr String
                expected :: Constr String
expected = Sing c -> Constr String
forall (c :: Constr Symbol). Sing c -> Constr String
knownConstr (SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @_ @c)
                actual :: Constr String
actual   = String -> String -> String -> Constr String
forall a. a -> a -> a -> Constr a
Constr String
pkg String
modl String
name
            if Constr String
expected Constr String -> Constr String -> Bool
forall a. Eq a => a -> a -> Bool
== Constr String
actual then do
              [Some Classified] -> [Box] -> IO [Some Classified]
goArgs [] [Box]
ptrArgs
            else do
--              tree <- showClosureTree 5 x
              String -> IO [Some Classified]
forall a. HasCallStack => String -> a
error (String -> IO [Some Classified]) -> String -> IO [Some Classified]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
                  String
"elimUserDefined: unexpected constructor"
                , String
"  closure:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FlatClosure -> String
forall a. Show a => a -> String
show FlatClosure
closure
                , String
"  expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Constr String -> String
forall a. Show a => a -> String
show Constr String
expected
                , String
"  actual:   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Constr String -> String
forall a. Show a => a -> String
show Constr String
actual
--                , "** TREE **"
--                , tree
--                , "** END OF TREE **"
                ]
          FlatClosure
_otherwise ->
            String -> IO [Some Classified]
forall a. HasCallStack => String -> a
error (String -> IO [Some Classified]) -> String -> IO [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 (Classified a)
forall a. a -> Either Closure (Classified a)
classified a
x of
      Right Classified a
classifier -> Int -> Classified a -> String -> String
forall a. Int -> Classified a -> String -> String
showClassifiedValue Int
0 Classified a
classifier String
""
      Left  Closure
closure    -> Closure -> String
forall a. Show a => a -> String
show Closure
closure

deriving instance Show (Classifier a)
deriving instance Show (MaybeF     Classified a)
deriving instance Show (EitherF    Classified a b)
deriving instance Show (MaybePairF Classified a b)
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

instance SListI xs => Show (Classifiers xs) where
  show :: Classifiers xs -> String
show (Classifiers NP Classified xs
xs) = NP (Dict (Compose Show Classified)) xs -> String
go ((forall a. Dict (Compose Show Classified) a)
-> NP (Dict (Compose Show Classified)) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure forall a. Dict (Compose Show Classified) a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict)
    where
      go :: NP (Dict (Compose Show Classified)) xs -> String
      go :: NP (Dict (Compose Show Classified)) xs -> String
go NP (Dict (Compose Show Classified)) xs
dicts =
          case NP (Dict (Compose Show Classified)) xs
-> Dict (All (Compose Show Classified)) xs
forall k (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP NP (Dict (Compose Show Classified)) xs
dicts of
            Dict (All (Compose Show Classified)) xs
Dict -> String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NP Classified xs -> String
forall a. Show a => a -> String
show NP Classified xs
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | 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 = Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
go
  where
    go :: Classifier a -> Dict Show a

    --
    -- Simple cases
    --

    -- Primitive types
    go :: Classifier a -> Dict Show a
go Classifier a
C_Bool     = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Char     = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Double   = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Float    = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Int      = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Int16    = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Int8     = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Int32    = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Int64    = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Integer  = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Ordering = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Unit     = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Word     = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Word8    = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Word16   = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Word32   = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Word64   = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    -- String types
    go Classifier a
C_String      = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_BS_Strict   = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_BS_Lazy     = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_BS_Short    = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Text_Strict = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_Text_Lazy   = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    -- Aeson
    go Classifier a
C_Value = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    -- Reference cells
    go Classifier a
C_STRef = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_TVar  = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go Classifier a
C_MVar  = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    -- Functions
    go Classifier a
C_Fun = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    -- User-defined
    go (C_Custom Sing c
SConstr) = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    --
    -- Compound
    --

    go (C_Maybe        MaybeF Classified a
c) = MaybeF Classified a -> Dict Show (Maybe a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c
    go (C_Either       EitherF Classified a b
c) = EitherF Classified a b -> Dict Show (Either a b)
forall (f :: * -> * -> *) a b.
(forall x y. (Show x, Show y) => Show (f x y)) =>
EitherF Classified a b -> Dict Show (f a b)
goEitherF    EitherF Classified a b
c
    go (C_List         MaybeF Classified a
c) = MaybeF Classified a -> Dict Show [a]
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c
    go (C_Ratio        Classified a
c) = Classified a -> Dict Show (Ratio a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
Classified a -> Dict Show (f a)
goF          Classified a
c
    go (C_Set          MaybeF Classified a
c) = MaybeF Classified a -> Dict Show (Set a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c
    go (C_Map          MaybePairF Classified a b
c) = MaybePairF Classified a b -> Dict Show (Map a b)
forall (f :: * -> * -> *) a b.
(forall x y. (Show x, Show y) => Show (f x y)) =>
MaybePairF Classified a b -> Dict Show (f a b)
goMaybePairF MaybePairF Classified a b
c
    go  Classifier a
C_IntSet          = Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    go (C_IntMap       MaybeF Classified a
c) = MaybeF Classified a -> Dict Show (IntMap a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c
    go (C_Sequence     MaybeF Classified a
c) = MaybeF Classified a -> Dict Show (Seq a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c
    go (C_Tree         Classified a
c) = Classified a -> Dict Show (Tree a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
Classified a -> Dict Show (f a)
goF          Classified a
c
    go (C_HashSet      Classified a
c) = Classified a -> Dict Show (HashSet a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
Classified a -> Dict Show (f a)
goF          Classified a
c
    go (C_HashMap      MaybePairF Classified a b
c) = MaybePairF Classified a b -> Dict Show (HashMap a b)
forall (f :: * -> * -> *) a b.
(forall x y. (Show x, Show y) => Show (f x y)) =>
MaybePairF Classified a b -> Dict Show (f a b)
goMaybePairF MaybePairF Classified a b
c
    go (C_HM_Array     MaybeF Classified a
c) = MaybeF Classified a -> Dict Show (Array a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c
    go (C_Vector_Boxed MaybeF Classified a
c) = MaybeF Classified a -> Dict Show (Vector a)
forall (f :: * -> *) a.
(forall x. Show x => Show (f x)) =>
MaybeF Classified a -> Dict Show (f a)
goMaybeF     MaybeF Classified a
c

    go (C_Tuple (Classifiers NP Classified xs
cs)) =
        case NP (Dict Show) xs -> Dict (All Show) xs
forall k (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP ((forall a. Classified a -> Dict Show a)
-> NP Classified xs -> NP (Dict Show) 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 (Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
canShowClassified (Classifier a -> Dict Show a)
-> (Classified a -> Classifier a) -> Classified a -> Dict Show a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classified a -> Classifier a
forall a. Classified a -> Classifier a
classifiedType) NP Classified xs
cs) of
          Dict (All Show) xs
Dict -> Dict Show a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    goMaybeF :: forall f a.
         (forall x. Show x => Show (f x))
      => MaybeF Classified a -> Dict Show (f a)
    goMaybeF :: MaybeF Classified a -> Dict Show (f a)
goMaybeF MaybeF Classified a
FNothing  = Dict Show (f a)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    goMaybeF (FJust Classified a
c) = case Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
go (Classified a -> Classifier a
forall a. Classified a -> Classifier a
classifiedType Classified a
c) of
                           Dict Show a
Dict -> Dict Show (f a)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    goEitherF :: forall f a b.
         (forall x y. (Show x, Show y) => Show (f x y))
      => EitherF Classified a b -> Dict Show (f a b)
    goEitherF :: EitherF Classified a b -> Dict Show (f a b)
goEitherF (FLeft  Classified a
c) = case Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
go (Classified a -> Classifier a
forall a. Classified a -> Classifier a
classifiedType Classified a
c) of
                             Dict Show a
Dict -> Dict Show (f a b)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    goEitherF (FRight Classified b
c) = case Classifier b -> Dict Show b
forall a. Classifier a -> Dict Show a
go (Classified b -> Classifier b
forall a. Classified a -> Classifier a
classifiedType Classified b
c) of
                             Dict Show b
Dict -> Dict Show (f a b)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    goF :: forall f a.
         (forall x. Show x => Show (f x))
      => Classified a -> Dict Show (f a )
    goF :: Classified a -> Dict Show (f a)
goF Classified a
c = case Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
go (Classified a -> Classifier a
forall a. Classified a -> Classifier a
classifiedType Classified a
c) of
              Dict Show a
Dict -> Dict Show (f a)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

    goMaybePairF :: forall f a b.
         (forall x y. (Show x, Show y) => Show (f x y))
      => MaybePairF Classified a b -> Dict Show (f a b)
    goMaybePairF :: MaybePairF Classified a b -> Dict Show (f a b)
goMaybePairF MaybePairF Classified a b
FNothingPair     = Dict Show (f a b)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
    goMaybePairF (FJustPair Classified a
c Classified b
c') = case ( Classifier a -> Dict Show a
forall a. Classifier a -> Dict Show a
go (Classified a -> Classifier a
forall a. Classified a -> Classifier a
classifiedType Classified a
c)
                                         , Classifier b -> Dict Show b
forall a. Classifier a -> Dict Show a
go (Classified b -> Classifier b
forall a. Classified a -> Classifier a
classifiedType Classified b
c')
                                         ) of
                                      (Dict Show a
Dict, Dict Show b
Dict) -> Dict Show (f a b)
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

instance KnownConstr c => Show (UserDefined c) where
  showsPrec :: Int -> UserDefined c -> String -> String
showsPrec Int
p UserDefined c
x =
      case UserDefined c -> [Some Classified]
forall (c :: Constr Symbol).
(HasCallStack, KnownConstr c) =>
UserDefined c -> [Some Classified]
fromUserDefined UserDefined c
x 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
      Constr{String
constrName :: forall a. Constr a -> a
constrName :: String
constrName} = Sing c -> Constr String
forall (c :: Constr Symbol). Sing c -> Constr String
knownConstr (SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @_ @c)