Examples.hs

-----------------------------------------------------------------------------
-- Copyright 2019, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- * This module provides an interface to structure a collection of examples.
-- Examples can be taken from (lists of) concrete values, or from random
-- generators. Both types can be marked as test items. Examples can be assigned
-- a level of difficulty (ranging from very easy to very difficult). Test items
-- do not have a difficulty level. Examples can be grouped into sub-collections
-- and assigned an identifier. Use the @Monoid@ operations for combining
-- examples.
--
-----------------------------------------------------------------------------

module Ideas.Common.Examples
   ( -- * Examples type
     Examples
     -- * Constructing examples
   , example, exampleList, examplesFor, examplesWithDifficulty
   , random, group, forTesting
     -- * Assigning difficulty
   , difficulty, veryEasy, easy, medium, difficult, veryDifficult
     -- * Transformations and queries
   , isEmpty, size, flatten, groups
   , topLevelExamples, topLevelRandoms, topLevelTests, topLevelRandomTests
   , allExamples, allRandoms, allTests, allRandomTests
     -- * Difficulty type
   , Difficulty(..), readDifficulty
   ) where

import Data.Char
import Data.Maybe
import Data.Semigroup
import Ideas.Common.Id
import Test.QuickCheck

-----------------------------------------------------------------------------
-- Examples

data Examples a = Examples
   { groups :: [(Id, Examples a)] -- ^ Top-level groups
   , items  :: [Item a]
   }

instance Semigroup (Examples a) where
   xs <> ys = Examples (groups xs <> groups ys) (items xs <> items ys)

instance Monoid (Examples a) where
   mempty  = Examples [] []
   mappend = (<>)

instance Functor Examples where
   fmap f (Examples xs ys) = Examples [ (n, fmap f g) | (n, g) <- xs ] (map (fmap f) ys)

data Item a = Example (Maybe Difficulty) a
            | Random  (Maybe Difficulty) (Gen a)
            | Test a
            | RandomTest (Gen a)

instance Functor Item where
   fmap f (Example d a)  = Example d (f a)
   fmap f (Test a)       = Test (f a)
   fmap f (Random d g)   = Random d (fmap f g)
   fmap f (RandomTest g) = RandomTest (fmap f g)

-- | One example
example :: a -> Examples a
example = single . Example Nothing

-- | List of examples
exampleList :: [a] -> Examples a
exampleList = Examples [] . map (Example Nothing)

-- | List of examples with the same difficulty
examplesFor :: Difficulty -> [a] -> Examples a
examplesFor d = examplesWithDifficulty . zip (repeat d)

-- | List of examples with their own difficulty
examplesWithDifficulty :: [(Difficulty, a)] -> Examples a
examplesWithDifficulty = Examples [] . map (uncurry (Example . Just))

-- | Use a random generator (from QuickCheck) as example generator
random :: Gen a -> Examples a
random = single . Random Nothing

group :: Id -> Examples a -> Examples a
group n xs = Examples [(n, xs)] []

-- | Assign difficulty (to all items without a difficulty level)
difficulty :: Difficulty -> Examples a -> Examples a
difficulty d = changeItems f
 where
   f (Example Nothing a) = Example (Just d) a
   f (Random Nothing a)  = Random  (Just d) a
   f x = x

-- | Turn examples (and random generators) into tests (and test generators)
forTesting :: Examples a -> Examples a
forTesting = changeItems f
 where
   f (Example _ a) = Test a
   f (Random _ a)  = RandomTest a
   f x = x

-- Querying

-- | Top-level examples
topLevelExamples :: Examples a -> [(Maybe Difficulty, a)]
topLevelExamples = collectItems f
 where
   f (Example md a) = Just (md, a)
   f _ = Nothing

-- | Top-level random generators
topLevelRandoms :: Examples a -> [(Maybe Difficulty, Gen a)]
topLevelRandoms = collectItems f
 where
   f (Random md g) = Just (md, g)
   f _ = Nothing

-- | Top-level test cases
topLevelTests :: Examples a -> [a]
topLevelTests = collectItems f
 where
   f (Test a) = Just a
   f _ = Nothing

-- | Top-level test generators
topLevelRandomTests :: Examples a -> [Gen a]
topLevelRandomTests = collectItems f
 where
   f (RandomTest g) = Just g
   f _ = Nothing

-- | All examples (also in groups)
allExamples :: Examples a -> [(Maybe Difficulty, a)]
allExamples = topLevelExamples . flatten

-- | All random generators (also in groups)
allRandoms :: Examples a -> [(Maybe Difficulty, Gen a)]
allRandoms = topLevelRandoms . flatten

-- | All test cases (also in groups)
allTests :: Examples a -> [a]
allTests = topLevelTests . flatten

-- | All test generators (also in groups)
allRandomTests :: Examples a -> [Gen a]
allRandomTests = topLevelRandomTests . flatten

-- | Flatten examples into one collection without subgroups
flatten :: Examples a -> Examples a
flatten = Examples [] . getItems

-- | Number of examples, including those in subgroups
size :: Examples a -> Int
size = length . getItems

-- | Tests if there ar no examples
isEmpty :: Examples a -> Bool
isEmpty = null . getItems

-- local helpers
single :: Item a -> Examples a
single x = Examples [] [x]

getItems :: Examples a -> [Item a]
getItems xs = concatMap (getItems . snd) (groups xs) ++ items xs

changeItems :: (Item a -> Item a) -> Examples a -> Examples a
changeItems f = rec
 where
   rec xs = Examples (map g (groups xs)) (map f (items xs))
   g (n, ys) = (n, rec ys)

collectItems :: (Item a -> Maybe b) -> Examples a -> [b]
collectItems f = mapMaybe f . items

-----------------------------------------------------------------------------
-- Difficulty

data Difficulty = VeryEasy | Easy | Medium | Difficult | VeryDifficult
   deriving (Eq, Ord, Enum)

instance Show Difficulty where
   show = (xs !!) . fromEnum
    where
      xs = ["very_easy", "easy", "medium", "difficult", "very_difficult"]

instance Read Difficulty where
   readsPrec _ s =
      case concatMap f txt of
         "veryeasy"      -> [(VeryEasy, xs)]
         "easy"          -> [(Easy, xs)]
         "medium"        -> [(Medium, xs)]
         "difficult"     -> [(Difficult, xs)]
         "verydifficult" -> [(VeryDifficult, xs)]
         _               -> []
    where
      (txt, xs) = span p (dropWhile isSpace s)
      p c   = isAlpha c || c `elem` "_-"
      f c   = [toLower c | c `notElem` "_-"]

-- | Parser for difficulty levels, which ignores non-alpha charactes (including
-- spaces) and upper/lower case distinction.
readDifficulty :: String -> Maybe Difficulty
readDifficulty s =
   case filter p [VeryEasy .. VeryDifficult] of
            [a] -> Just a
            _   -> Nothing
 where
   normal = filter isAlpha . map toLower
   p = (== normal s) . normal . show

veryEasy, easy, medium, difficult, veryDifficult :: Examples a -> Examples a
veryEasy      = difficulty VeryEasy
easy          = difficulty Easy
medium        = difficulty Medium
difficult     = difficulty Difficult
veryDifficult = difficulty VeryDifficult