-
-
Save mpickering/e19f6a5590a74fc36752 to your computer and use it in GitHub Desktop.
Difference between two implementations
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 FlexibleInstances #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE TypeFamilies #-} | |
import Control.Applicative | |
import Control.Monad.Identity | |
class Applicative (I g) => Idiomatic g where | |
type I g :: * -> * | |
type F g | |
idiomatic :: (I g) (F g) -> g | |
iI :: Idiomatic g => (F g) -> g | |
iI = idiomatic . pure | |
data Ii = Ii | |
instance Applicative i => Idiomatic (Ii -> i x) where | |
type I (Ii -> i x) = i | |
type F (Ii -> i x) = x | |
idiomatic xi Ii = xi | |
instance (Idiomatic g, i ~ I g) => Idiomatic (i s -> g) where | |
type I (i s -> g) = i | |
type F (i s -> g) = s -> F g | |
idiomatic sfi si = idiomatic (sfi <*> si) | |
f :: Identity Int | |
f = iI (+) (Identity 5) (Identity 5) Ii | |
main :: IO () | |
main = print . runIdentity $ f |
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 FunctionalDependencies #-} | |
{-# LANGUAGE AllowAmbiguousTypes #-} | |
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE OverlappingInstances #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE UndecidableInstances #-} | |
module Vogt where | |
-- https://gist.github.com/aavogt/433969cc83548e1f59ea | |
class ApplyAB f a b where | |
applyAB :: f -> a -> b | |
applyAB = undefined -- In case we use Apply for type-level computations only | |
import Control.Applicative | |
class InfixF f as t where | |
iIwith :: f -> as -> t | |
data Ii = Ii | |
instance (as ~ as') => InfixF f as (Ii -> as') where | |
iIwith f as Ii = as | |
instance (ApplyAB f (as,a) as', InfixF f as' b) => InfixF f as (a -> b) where | |
iIwith f as a = iIwith f (applyAB f (as,a) :: as') | |
iI :: forall f as t. InfixF (App f) as t => as -> t | |
iI = iIwith (App :: App f) | |
data App (f :: * -> *) = App | |
instance (fabfa ~ (f (a -> b), f a), | |
fb ~ f b, | |
Applicative f) => ApplyAB (App f) fabfa fb where | |
applyAB _ = uncurry (<*>) | |
x,y,z :: Maybe Int | |
f = Just (,,); x = Just 1; y = Just 2; z = Just 3 | |
g :: Maybe (Int, Int, Int) | |
g = iI f x y z Ii | |
h :: Maybe (Int, Int, Int) | |
h = iI f x y (iI x Ii) Ii |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment