n-ary homogeneous functions as a free Applicative functor

N.hs

{-# LANGUAGE UnicodeSyntax #-}

-- n-ary functions s^n → a.
-- N s is the free Applicative on Reader s.
-- It encodes the effect "ask for one s", but since it's an Applicative
-- and not a Monad you can statically know how many arguments a function requires.
data N s a = Pure a | Ask (N s (s → a))

arity :: N s a → Integer
arity (Pure _) = 0
arity (Ask n) = arity n + 1

-- Feed one s as the *first* argument to a computation.
-- `fmap ($ s)` would apply `s` as the *last* argument, which is not what we want.
feed1 :: N s (s → a) → s → N s a
feed1 (Pure f) s = Pure (f s)
feed1 (Ask n) s = Ask (feed1 n s)

-- Recursively feed strings from a list to a computation until it produces a result,
-- and return the remaining strings as well.
feed :: N s a → [s] → (a, [s])
feed (Pure a) xs = (a, xs)
feed (Ask n) (x:xs) = feed (feed1 n x) xs
feed (Ask n) _ = error "no more strings"

-- Concatenate three strings.
concat3 :: N String String
concat3 = Ask $ Ask $ Ask $ Pure $
  \ a b c → a ++ b ++ c

main :: IO ()
main = do
  print $ arity concat3 -- 3
  print $ feed concat3 ["a", "b", "c", "d", "e"] -- ("abc",["d","e"])