Created
September 8, 2024 13:01
-
-
Save Lysxia/4ca19f957ce6e50400fb0b15c53732ed to your computer and use it in GitHub Desktop.
Fixed OP's code https://old.reddit.com/r/haskell/comments/1fbl003/update_a_function_to_replace_all_case_expressions/
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE MultiParamTypeClasses #-} | |
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE DefaultSignatures #-} | |
| {-# LANGUAGE FlexibleContexts #-} | |
| {-# LANGUAGE ScopedTypeVariables #-} | |
| {-# LANGUAGE DeriveGeneric #-} | |
| {-# LANGUAGE TypeOperators #-} | |
| {-# LANGUAGE UndecidableInstances #-} | |
| {-# LANGUAGE AllowAmbiguousTypes #-} | |
| {-# LANGUAGE TypeApplications #-} | |
| {-# LANGUAGE FunctionalDependencies #-} | |
| {-# LANGUAGE RankNTypes #-} | |
| {-# LANGUAGE EmptyCase #-} | |
| import GHC.Generics | |
| class GCase f a b where | |
| gCase :: f p -> a -> b | |
| instance GCase f a b => GCase (M1 i t f) a b where | |
| gCase (M1 x) = gCase x | |
| instance (GCase f a c, GCase g b c) => GCase (f :+: g) a (b -> c) where | |
| gCase (L1 x) = \a _ -> gCase x a | |
| gCase (R1 x) = \_ b -> gCase x b | |
| -- Before: | |
| -- instance (GCase f (a -> b -> c) a, GCase g (a -> b -> c) b) => GCase (f :*: g) (a -> b -> c) c where | |
| -- gCase (x :*: y) = \f -> f (gCase x f) (gCase y f) | |
| instance (GCase f a b, GCase g b c) => GCase (f :*: g) a c where | |
| gCase (f :*: g) = gCase @g @b @c g . gCase f | |
| -- Before: | |
| -- instance GCase U1 a a where | |
| instance (a ~ b) => GCase U1 a b where | |
| gCase U1 = id | |
| -- Before: | |
| -- instance Case c a b => GCase (K1 i c) a b where | |
| -- gCase (K1 x) = case' x | |
| -- | |
| -- class Case a b c where | |
| -- case' :: a -> b -> c | |
| -- | |
| -- instance Case c (c -> b) b where | |
| -- case' x k = k x | |
| instance (a ~ (c -> b)) => GCase (K1 i c) a b where | |
| gCase (K1 x) k = k x | |
| data Unit = Unit deriving (Show, Generic) | |
| data Bit = I | O deriving (Show, Generic) | |
| data Product = P Int Char deriving (Show, Generic) | |
| i1 :: Int | |
| i1 = 1 | |
| main = do | |
| print $ ((gCase (from Unit) 'a')) -- 'a' | |
| print $ ((gCase (from Unit) i1) :: Int) -- 1 | |
| print $ ((gCase (from I) 'a' 'b') :: Char) -- 'a' | |
| print $ ((gCase (from O) 'a' 'b') :: Char) -- 'b' | |
| print $ maybe' i1 (+i1) Nothing -- 1 | |
| print $ maybe' i1 (+i1) (Just 1) -- 2 | |
| print $ either' (show :: Char -> String) (show . (+i1)) (Left 'a') -- "'a'" | |
| print $ either' (show :: Char -> String) (show . (+i1)) (Right 10) -- 11 | |
| -- Fixed | |
| print $ ((gCase (from (P 3 'a'))) (\(a :: Int) (b :: Char) -> (a, b))) -- (3, 'a') | |
| maybe' :: b -> (a -> b) -> Maybe a -> b | |
| maybe' def f x = gCase (from x) def f | |
| either' :: (a -> c) -> (b -> c) -> Either a b -> c | |
| either' r l x = gCase (from x) r l |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment