----------------------------------------------------------------------------- -- 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