Discussion on: Daily Challenge #68 - Grade Book

[Rebecca Skinner]

Here's my type-level implementation in haskell:

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}

module Lib where
import GHC.TypeLits

data PlusMinus g = Plus g | Minus g | None g

data Grade = A | B | C | D | F

infixr 5 :->
data GradeMapping minScore grade = minScore :-> grade

type StandardGradingCurve = '[90 :-> A, 80 :-> B, 70 :-> C, 60 :-> D, 0 :-> F]

type family LookupGrade (c :: [GradeMapping score grade]) (s :: score) :: grade where
  LookupGrade m k = LookupGrade' m k k

type family LookupGrade' (c :: [GradeMapping score grade]) (s :: score) (s' :: score) :: grade where
  LookupGrade' '[] k k' = F
  LookupGrade' ((k :-> v) ': c) k k' = v
  LookupGrade' ((k :-> v) ': c) 0 k' = LookupGrade' c k' k'
  LookupGrade' ((k :-> v) ': c) n k' = LookupGrade' ((k :-> v) ': c) (n - 1) k'
  LookupGrade' ((kvm) ': c) k k' = LookupGrade' c k k'

type family IfThenElse (cond :: Bool) (whenTrue :: b) (whenFalse :: b) :: b where
  IfThenElse True trueBranch falseBranch = trueBranch
  IfThenElse False trueBranch falseBranch = falseBranch

type family LessThan (a :: Nat) (b :: Nat) :: Bool where
  LessThan a a = False
  LessThan a 0 = False
  LessThan 0 b = True
  LessThan a b = LessThan (a - 1) (b - 1)

type family OnesFamily (n :: Nat) :: Nat where
  OnesFamily 0 = 0
  OnesFamily n = IfThenElse (LessThan n 10) n (OnesFamily (n - 10))

type family MakePlusMinus (n :: Nat) (val :: a) :: PlusMinus a where
  MakePlusMinus score val =
    IfThenElse (LessThan (OnesFamily score) 5) (Minus val) (IfThenElse (LessThan 5 (OnesFamily score)) (Plus val) (None val))

type family Sum (vals :: [Nat]) :: Nat where
  Sum vals = Sum' 0 vals

type family Sum' (total :: Nat) (vals :: [Nat]) :: Nat where
  Sum' n '[] = n
  Sum' n (a ': as) = Sum' (n + a) as

type family Length (vals :: [a]) :: Nat where
  Length '[] = 0
  Length (val ': vals) = 1 + (Length vals)

type family Mean (vals :: [Nat]) :: Nat where
  Mean vals = Div (Sum vals) (Length vals)

type family CalcGrade (vals :: [Nat]) :: PlusMinus Grade where
  CalcGrade vals = MakePlusMinus (Mean vals) (LookupGrade StandardGradingCurve (Mean vals))