Skip to content

Instantly share code, notes, and snippets.

@kosmikus
Created April 2, 2018 11:11
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kosmikus/3db332604190637bc93cede5031ea0e3 to your computer and use it in GitHub Desktop.
Save kosmikus/3db332604190637bc93cede5031ea0e3 to your computer and use it in GitHub Desktop.
Generic validation using generic-sop
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Person where
import Generics.SOP
import qualified GHC.Generics as GHC
data Person' f =
Person
{ pName :: HKD f String
, pAge :: HKD f Int
} deriving (GHC.Generic, Generic)
type family HKD (f :: * -> *) (a :: *) :: * where
HKD I a = a
HKD f a = f a
type Person = Person' I
type MaybePerson = Person' Maybe
validate ::
( Generic (a f), Generic (a I), Applicative f
, AllZip2 (LiftedCoercible I f) (Code (a f)) (Code (a I))
) => a f -> f (a I)
validate =
(to <$>) . hsequence . hcoerce . from
validatePerson :: Person' Maybe -> Maybe (Person' I)
validatePerson = validate
@kosmikus
Copy link
Author

invalidatePerson :: Person' I -> Person' Maybe
invalidatePerson = to . hcoerce . hmap (Just . unI) . from

@kim
Copy link

kim commented Jan 24, 2019

Generalising a bit:

invalidate
    :: ( Generic (a f)
       , Generic (a I)
       , AllZip2 (LiftedCoercible f I) (Code (a I)) (Code (a f))
       )
    => (forall b. b -> f b)
    -> a I
    -> a f
invalidate f = to . hcoerce . hmap (f . unI) . from

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment