Skip to content

Instantly share code, notes, and snippets.

@aavogt
Last active August 29, 2015 14:15
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save aavogt/433969cc83548e1f59ea to your computer and use it in GitHub Desktop.
generalization of idiom brackets
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module VogtNoApplyAB where
import Control.Applicative
class InfixF a b where
iI :: a -> b
data Ii = Ii
instance (r ~ r') => InfixF r (Ii -> r') where
iI r Ii = r
-- or if we hate -XOverlappingInstances, and are willing to put up with
-- what might be worse type inference,
-- > instance _ => InfixF fab (f a -> r) where
instance (Applicative f, fab ~ f (a -> b), fa ~ f a,
InfixF (f b) r) => InfixF fab (f a -> r) where
iI fab fa = iI (fab <*> fa)
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
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module IiWith where
import Data.HList.CommonMain
import Control.Applicative
{- | this is mostly inspired by
http://hackage.haskell.org/package/uu-parsinglib-2.8.1.1/docs/Text-ParserCombinators-UU-Idioms.html#t:Idiomatic
The idea is that
> iIwith FUN x y z Ii
expands out to
> x `fun` y `fun` z
provided there is an
> instance ApplyAB FUN x y where applyAB _ = fun
-}
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')
{- | Idiom brackets as a special case of iIwith
>>> let f = Just (,,); x = Just 1; y = Just 2; z = Just 3
>>> iI f x y z Ii
Just (1,2,3)
>>> iI f x y (iI f x y z Ii) Ii
Just (1,2,(1,2,3))
-}
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 (<*>)
{- | infixr version
Another way to write hBuild:
>>> iIwithR HConsF 'a' "b" () [(),()] HNil Ii
H['a',"b",(),[(),()]]
-}
iIwithR :: InfixFr f '[] t => f -> t
iIwithR f = iIwithR' f HNil
class InfixFr f as t where
iIwithR' :: f -> HList as -> t
instance (InfixFr f (a ': as) c) => InfixFr f as (a -> c) where
iIwithR' f as a = iIwithR' f (HCons a as)
instance (aas ~ (a ': as), HRevAppR as '[] ~ sa, HRevApp as '[],
HFoldr f a sa b) => InfixFr f aas (Ii -> b) where
iIwithR' f (HCons a as) Ii = hFoldr f a (hReverse as)
data HConsF = HConsF
instance (y ~ HList (x ': xs),
xxs ~ (x, HList xs) ) => ApplyAB HConsF xxs y where
applyAB _ = uncurry HCons
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment