Example code for 1DevDay talk

TypeDirected.hs

{-#Language DeriveFunctor
          , DeriveFoldable
          , DeriveTraversable #-}

import Control.Applicative

import Data.Foldable
import Data.Traversable

import Prelude hiding (sum)

data Cons f a = Cons a (f a)
  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

data Nil a = Nil
  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

class (Applicative f, Traversable f) => FixedList f
instance FixedList f => FixedList (Cons f)
instance FixedList Nil

instance Applicative Nil where
  pure a = Nil
  f <*> a = Nil

instance (FixedList f) => Applicative (Cons f) where
  pure a = Cons a $ pure a
  Cons f f' <*> Cons a a' = Cons (f a) $ (f' <*> a')

addVec :: (Num a, FixedList f) => f a -> f a -> f a
addVec = liftA2 (+)

mulVec :: (Num a, FixedList f) => f a -> f a -> f a
mulVec = liftA2 (*)

dot :: (Num a, FixedList f) => f a -> f a -> a
dot a b = sum $ liftA2 (*) a b

mulMat :: (Num a, FixedList f, FixedList g, FixedList h) => f (g a) -> g (h a) -> f (h a)
mulMat a b = traverse (liftA2 dot a . pure) (sequenceA b)

v1 = Cons 2 $ Cons 1 $ Cons 7 $ Nil
v2 = Cons 1 $ Cons 4 $ Cons 6 $ Nil

v3 = Cons 4 $ Cons 9 $ Nil
v4 = Cons 8 $ Cons 1 $ Nil
v5 = Cons 5 $ Cons 3 $ Nil

m1 = Cons v1 $ Cons v2 $ Nil
m2 = Cons v3 $ Cons v4 $ Cons v5 $ Nil