Module to facilitate var-args style functions.

VarArgs.hs

{-# LANGUAGE
      FlexibleInstances, FlexibleContexts, UndecidableInstances,
      TypeFamilies, DataKinds, GADTs, ConstraintKinds, TypeOperators,
      MultiParamTypeClasses, FunctionalDependencies 
  #-}

module VarArgs (
  -- * Core
  Args(..), args,
  -- * Utility
  All, Homogeneous,
  -- * Examples
  asList, listShow, listDynamic, adder, counter, average
) where

import Data.Kind (Type, Constraint)
import Data.Dynamic (Typeable, Dynamic, toDyn)

-- | Arguments object, parametrized over the types of the arguments it has collected.
data Args (as :: [Type]) where
  Nil :: Args '[]
  (:-) :: Args as -> a -> Args (a ': as)

-- | Typeclass for passing along an 'Args' object to fill with arguments
class VarArgs as t | t -> as where
  args' :: Args as -> t

-- | Base case
instance VarArgs as (Args as) where
  args' = id

-- | Inductive step
instance (VarArgs (a ': as) t) => VarArgs as (a -> t) where
  args' as a = args' (as :- a)

-- | Helper which passes in the empty 'Args' object the base case requires
args :: VarArgs '[] t => t
args = args' Nil


type family All (c :: Type -> Constraint) (as :: [Type]) :: Constraint where
  All c '[] = ()
  All c (a ': as) = (All c as, c a)

type Homogeneous (b :: Type) (as :: [Type]) = All ((~) b) as

-- SAMPLE USES:

-- | Convert an 'Args' object into a list if all the elements in that object have the same type
--
-- >>> asList (args "foo" "bar" "baz")
-- ["foo","bar","baz"]
asList :: Homogeneous b as => Args as -> [b]
asList Nil = []
asList (xs :- x) = asList xs ++ [x]

-- | Convert an 'Args' object into a list of the shown symbols
--
-- >>> listShow (args 1 () "hi")
-- ["1","()","\"hi\""]
listShow :: All Show as => Args as -> [String]
listShow Nil = []
listShow (xs :- x) = listShow xs ++ [ show x ]

-- | Convert an 'Args' object into a list of 'Dynamic'
--
-- >>> listDynamic (args 1 () "hi")
-- [<<Integer>>,<<()>>,<<[Char]>>]
listDynamic :: All Typeable as => Args as -> [Dynamic]
listDynamic Nil = []
listDynamic (xs :- x) = listDynamic xs ++ [ toDyn x ]

-- | Add up all the arguments
--
-- >>> adder (args 1 2.0 3)
-- 6.0
adder :: (Num b, Homogeneous b as) => Args as -> b
adder xs = foldr (+) 0 (asList xs)

-- | Count up all the arguments
--
-- >>> counter (args 1 () "hi")
-- 3
counter :: Num a => Args as -> a
counter Nil = 0
counter (xs :- _) = 1 + counter xs

-- | Take the average of all the arguments
--
-- >>> average (args 1 5 8 9)
-- 5.75
average :: (Fractional b, Homogeneous b as) => Args as -> b
average xs = adder xs / counter xs