data-diverse-1.2.0.0: Extensible records and polymorphic variants.

Safe HaskellSafe
LanguageHaskell2010

Data.Diverse.CaseFunc

Synopsis

Documentation

newtype CaseFunc k r xs Source #

This handler stores a polymorphic function that returns a different type.

let y = pick (5 :: Int) :: Which '[Int, Bool]
switch y (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) `shouldBe` Int
let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul
afoldr (:) [] (forMany (CaseFunc @Typeable (show . typeRep . (pure @Proxy))) x) `shouldBe`
    ["Int", "Bool", "Char", "Maybe Char", "Int", "Maybe Char"]

Constructors

CaseFunc (forall x. k x => x -> r) 

Instances

Reiterate (CaseFunc k r) xs Source # 

Methods

reiterate :: CaseFunc k r xs -> CaseFunc k r (Tail Type xs) Source #

k x => Case (CaseFunc k r) ((:) Type x xs) Source # 

Methods

case' :: CaseFunc k r ((Type ': x) xs) -> Head Type ((Type ': x) xs) -> CaseResult * Type (CaseFunc k r) (Head Type ((Type ': x) xs)) Source #

type CaseResult * Type (CaseFunc k r) x Source # 
type CaseResult * Type (CaseFunc k r) x = r

newtype CaseFunc' k xs Source #

This handler stores a polymorphic function that doesn't change the type.

let x = (5 :: Int) ./ (6 :: Int8) ./ (7 :: Int16) ./ (8 :: Int32) ./ nil
    y = (15 :: Int) ./ (16 :: Int8) ./ (17 :: Int16) ./ (18 :: Int32) ./ nil
afmap (CaseFunc' @Num (+10)) x `shouldBe` y

Constructors

CaseFunc' (forall x. k x => x -> x) 

Instances

Reiterate (CaseFunc' k) xs Source # 

Methods

reiterate :: CaseFunc' k xs -> CaseFunc' k (Tail Type xs) Source #

k x => Case (CaseFunc' k) ((:) Type x xs) Source # 

Methods

case' :: CaseFunc' k ((Type ': x) xs) -> Head Type ((Type ': x) xs) -> CaseResult * Type (CaseFunc' k) (Head Type ((Type ': x) xs)) Source #

type CaseResult * Type (CaseFunc' k) x Source # 
type CaseResult * Type (CaseFunc' k) x = x