module Ideas.Common.Examples
(
Examples
, example, exampleList, examplesFor, examplesWithDifficulty
, random, group, forTesting
, difficulty, veryEasy, easy, medium, difficult, veryDifficult
, isEmpty, size, flatten, groups
, topLevelExamples, topLevelRandoms, topLevelTests, topLevelRandomTests
, allExamples, allRandoms, allTests, allRandomTests
, Difficulty(..), readDifficulty
) where
import Data.Char
import Data.Maybe
import Data.Semigroup
import Ideas.Common.Id
import Test.QuickCheck
data Examples a = Examples
{ groups :: [(Id, Examples a)]
, 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)
example :: a -> Examples a
example = single . Example Nothing
exampleList :: [a] -> Examples a
exampleList = Examples [] . map (Example Nothing)
examplesFor :: Difficulty -> [a] -> Examples a
examplesFor d = examplesWithDifficulty . zip (repeat d)
examplesWithDifficulty :: [(Difficulty, a)] -> Examples a
examplesWithDifficulty = Examples [] . map (uncurry (Example . Just))
random :: Gen a -> Examples a
random = single . Random Nothing
group :: Id -> Examples a -> Examples a
group n xs = Examples [(n, xs)] []
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
forTesting :: Examples a -> Examples a
forTesting = changeItems f
where
f (Example _ a) = Test a
f (Random _ a) = RandomTest a
f x = x
topLevelExamples :: Examples a -> [(Maybe Difficulty, a)]
topLevelExamples = collectItems f
where
f (Example md a) = Just (md, a)
f _ = Nothing
topLevelRandoms :: Examples a -> [(Maybe Difficulty, Gen a)]
topLevelRandoms = collectItems f
where
f (Random md g) = Just (md, g)
f _ = Nothing
topLevelTests :: Examples a -> [a]
topLevelTests = collectItems f
where
f (Test a) = Just a
f _ = Nothing
topLevelRandomTests :: Examples a -> [Gen a]
topLevelRandomTests = collectItems f
where
f (RandomTest g) = Just g
f _ = Nothing
allExamples :: Examples a -> [(Maybe Difficulty, a)]
allExamples = topLevelExamples . flatten
allRandoms :: Examples a -> [(Maybe Difficulty, Gen a)]
allRandoms = topLevelRandoms . flatten
allTests :: Examples a -> [a]
allTests = topLevelTests . flatten
allRandomTests :: Examples a -> [Gen a]
allRandomTests = topLevelRandomTests . flatten
flatten :: Examples a -> Examples a
flatten = Examples [] . getItems
size :: Examples a -> Int
size = length . getItems
isEmpty :: Examples a -> Bool
isEmpty = null . getItems
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
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` "_-"]
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