Last active
July 26, 2021 22:29
-
-
Save mgsloan/7100f55c6ec12be8776a1a1c347cf963 to your computer and use it in GitHub Desktop.
Function composition where 2nd function is variadic
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 DataKinds #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeApplications #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE UndecidableInstances #-} | |
import Data.Proxy (Proxy(..)) | |
-- | Typeclass to compose a function (f :: a -> b) with the result | |
-- of a function (g) which has any number of arguments, resulting in a | |
-- function with type (h). | |
class MapResult (gHasArg :: Bool) f g h where | |
mapResultImpl :: Proxy gHasArg -> f -> g -> h | |
-- | Handle base case where (g) is the result value to map. | |
instance MapResult 'False (a -> r) a r where | |
mapResultImpl _ f x = f x | |
-- | Handle recursive case. | |
instance | |
MapResult (HasArg g) f g h | |
=> MapResult 'True f (x -> g) (x -> h) where | |
mapResultImpl _ f g = | |
\x -> mapResultImpl (Proxy @ (HasArg g)) f (g x) | |
-- | Composes a function (a -> b) with a variadic function (g) which | |
-- has a final result type of (a). | |
-- | |
-- This is a wrapper around mapResultImpl which provides a Proxy of an | |
-- appropriate type. It also uses some type families for getting the | |
-- ResultType of (g) and substituting the result type. The usage of | |
-- these type families could be omitted, but this would result in poor | |
-- type inference (more explicit types needed) and poor type errors. | |
mapResult | |
:: forall a b g h. | |
( a ~ ResultType g | |
, h ~ WithResultType b g | |
, MapResult (HasArg g) (a -> b) g h | |
) | |
=> (a -> b) -> g -> h | |
mapResult = mapResultImpl (Proxy @ (HasArg g)) | |
-------------------------------------------------------------------------------- | |
-- Usage example | |
-------------------------------------------------------------------------------- | |
showAddNumbers :: Int -> Int -> String | |
showAddNumbers = mapResult show (+) | |
showAdd3Numbers :: Int -> Int -> Int -> String | |
showAdd3Numbers = mapResult show (\x y z -> x + y + z) | |
main :: IO () | |
main = do | |
putStrLn (showAddNumbers 24 13) | |
putStrLn (showAdd3Numbers 24 13 36) | |
-------------------------------------------------------------------------------- | |
-- Type families to operate on functions | |
-------------------------------------------------------------------------------- | |
-- | Gets result type of a function. | |
type family ResultType f where | |
ResultType (_ -> f) = ResultType f | |
ResultType r = r | |
-- | Substitutes result type of a function with another type. | |
type family WithResultType a f where | |
WithResultType a (b -> f) = b -> WithResultType a f | |
WithResultType a _ = a | |
-- | Checks whether the specified type is a function type. | |
type family HasArg f where | |
HasArg (_ -> _) = 'True | |
HasArg _ = 'False |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment