Messing around with Typeable.

Form.hs

{-# LANGUAGE
    DataKinds
  , DeriveAnyClass
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , FunctionalDependencies
  , GeneralizedNewtypeDeriving
  , PolyKinds
  , TypeFamilies
  , KindSignatures
  , MultiParamTypeClasses
  , ScopedTypeVariables
  , TypeApplications
  , TypeOperators
  , UndecidableInstances
#-}

module Form where

import           Control.Applicative ((<|>), liftA2)
import           Data.Dynamic        (Dynamic, toDyn, fromDynamic)
import           Data.Kind           (Type)
import           Data.Map            (Map)
import           GHC.Generics
import           GHC.TypeLits        (AppendSymbol, KnownSymbol, Symbol, symbolVal)
import           Type.Reflection     (SomeTypeRep, Typeable, someTypeRep)
import qualified Data.Map            as Map

data Proxy a
  = Proxy

data Person
  = Person
      { firstName :: String
      , lastName  :: String
      }
  deriving Show

data Age
  = Age Int
  deriving Show

newtype Bag
  = Bag (Map SomeTypeRep Dynamic)
  deriving newtype Monoid
  deriving stock   Show

---

insert
  :: forall value
   . Typeable value
  => value
  -> Bag
  -> Bag

insert value (Bag bag)
  = Bag (Map.insert typeRep encoded bag)
  where
    encoded = toDyn value
    typeRep = someTypeRep (Proxy @value)

lookup
  :: forall value key
   . Typeable value
  => Bag
  -> Maybe value

lookup (Bag bag)
  = Map.lookup typeRep bag >>= fromDynamic
  where
    typeRep = someTypeRep (Proxy @value)

---

class GenericPopulate (rep :: Type -> Type) where
  gpopulate :: forall p. Bag -> Maybe (rep p)

instance GenericPopulate inner
    => GenericPopulate (M1 lol wut inner) where
  gpopulate bag = fmap M1 (gpopulate bag)

instance (GenericPopulate left, GenericPopulate right)
    => GenericPopulate (left :+: right) where
  gpopulate bag
     =  fmap L1 (gpopulate bag)
    <|> fmap R1 (gpopulate bag)

instance (GenericPopulate left, GenericPopulate right)
    => GenericPopulate (left :*: right) where
  gpopulate bag
     = liftA2 (:*:) (gpopulate bag) (gpopulate bag)

instance GenericPopulate U1 where
  gpopulate _
    = Just U1

instance Typeable variable => GenericPopulate (K1 huh variable) where
  gpopulate
    = fmap K1 . Form.lookup @variable

populate
  :: ( Generic structure
     , GenericPopulate (Rep structure)
     )
  => Bag -> Maybe structure

populate
  = fmap to . gpopulate

---

newtype Primary a
  = Primary a

test
  = show
  . Form.lookup @Person
  . Form.insert (Person "Joe" "Bloggs")
  $ mempty

data Spec
  = Spec
      { person :: Person
      , age    :: Age
      }
  deriving (Generic, Show)

test2 :: Maybe Spec
test2
  = populate @Spec
  . insert (Age 12)
  . insert (Person "Joe" "Bloggs")
  $ mempty