NamedArguments.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
module NamedArguments where

import GHC.TypeLits
import Data.Reflection  -- from `reflection`
import Data.Tagged      -- from `tagged`


type Arg (s :: Symbol) a = Given (Tagged s a)

arg :: forall (s :: Symbol) a. Arg s a => a
arg = unTagged (given :: Tagged s a)

with :: forall (s :: Symbol) a r. a -> (Arg s a => r) -> r
with x = give (Tagged x :: Tagged s a)


-- define functions with named parameters
hello :: Arg "name" String => String
hello = "hello, " ++ arg @"name" ++ "!"

add :: Arg "x" Int => Arg "y" Int => Int
add = arg @"x" + arg @"y"

-- and call them!
helloWorld :: String
helloWorld = with @"name" "world" hello

-- annotations required for using `add`
onePlusTwo :: Int
onePlusTwo = with @"x" (1 :: Int) $ with @"y" (2 :: Int) $ add


-- convenient: just pass on arguments implicitly
helloTwice :: Arg "name" String => String
helloTwice = hello ++ " " ++ hello
-- > with @"name" "john" helloTwice
-- "hello john! hello john!"

-- or share arguments:
calculation :: Int
calculation = -- (10+1) * (10+2) * (10+3)
  with @"x" (10 :: Int)
  $ with @"y" (1 :: Int) add
  * with @"y" (2 :: Int) add
  * with @"y" (3 :: Int) add

-- but you can still choose to pass on a different value:
-- > with @"name" "john" helloWorldAnd
-- "hello john! hello world!"
helloWorldAnd :: Arg "name" String => String
helloWorldAnd = hello ++ " " ++ helloWorld
  where
    -- this really needs to be in a `where`.
    -- otherwise, it just greats the given name instead of "world"
    -- note that having multiple instances in scope causes implementation defined behavior!
    -- (but it seems to work)
    helloWorld = with @"name" "world" hello

-- recursion!
sum' :: Arg "list" [Int] => Int
sum' = go @"list"
  where
    go :: forall s. Arg s [Int] => Int
    go = case arg @s of
      [] -> 0
      (x:xs) -> x + with @"xs" xs (go @"xs")

-- polymorphism works, but requires some extra annotations
add' :: forall n. Num n => Arg "x" n => Arg "y" n => n
add' = arg @"x" + arg @"y"

onePlusTwo' :: forall n. Num n => n
onePlusTwo' = with @"x" (1 :: n) $ with @"y" (2 :: n) $ add'

-- sadly, higher order functions don't seem to work.
-- e.g. `($) :: Arg "f" (Arg "y" a => b) => Arg "x" a => b` is an illegal type