Questions.hs

{-# language DataKinds, GADTs, DuplicateRecordFields, StandaloneDeriving #-}
module Questions where

import Data.Kind (Type)

data Nat = Z | S Nat
  deriving Show

data Vec :: Nat -> Type -> Type where
  Nil :: Vec 'Z a
  Cons :: a -> Vec n a -> Vec ('S n) a
  
deriving instance Show a => Show (Vec n a)

data Index :: Nat -> Type where
  ZI :: Index ('S n)
  SI :: Index n -> Index ('S n)
  
deriving instance Show (Index n)

data MultiChoice where
  MultiChoice :: { question :: String, choices :: Vec n String, answer :: Index n } -> MultiChoice

deriving instance Show MultiChoice

findIndex :: Eq a => a -> Vec n a -> Maybe (Index n)
findIndex element Nil = Nothing
findIndex element (Cons element' rest) =
  if element == element'
  then Just ZI
  else do
    index <- findIndex element rest
    pure (SI index) 

data SNat :: Nat -> Type where
  SZ :: SNat 'Z
  SS :: SNat n -> SNat ('S n)

deriving instance Show (SNat n)

data SomeVec :: Type -> Type where
  SomeVec :: SNat n -> Vec n a -> SomeVec a

deriving instance Show a => Show (SomeVec a)

fromList :: [a] -> SomeVec a
fromList [] = SomeVec SZ Nil
fromList (a : as) =
  case fromList as of
    SomeVec len as' -> SomeVec (SS len) (Cons a as')

data Error = AnswerNotInChoices{ answer :: String, choices :: [String] }
  deriving Show

multiChoice :: String -> [String] -> String -> Either Error MultiChoice
multiChoice question choices answer =
  case fromList choices of
    SomeVec len choices' ->
      case findIndex answer choices' of
        Nothing ->
          Left AnswerNotInChoices{ answer = answer, choices = choices }
        Just index ->
          Right MultiChoice{ 
            question = question,
            choices = choices', 
            answer = index
          }