Data.hs

module Test.Data
    ( -- * Lenses
      Haskeller (..)
    , nameL
    , knowledgeL

    , Knowledge (..)
    , syntaxL

    , me

      -- * Prisms
    , Grade (..)
    , _Mark

    , gradeMark
    , gradeOther

      -- * Generators
    , genFun
    , genFunction
    , genForget
    , genHaskeller
    , genInt
    , genKnowledge
    , genName
    ) where

import Test.Hspec.Hedgehog (MonadGen)

import Prolens (Forget (..), Fun (..), Lens', Prism', lens, prism')

import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range


data Haskeller = Haskeller
    { haskellerName       :: String
    , haskellerExperience :: Int
    , haskellerKnowledge  :: Knowledge
    } deriving stock (Show, Eq)

data Knowledge = Knowledge
    { kSyntax         :: Bool
    , kMonads         :: Bool
    , kLens           :: Bool
    , kTypeLevelMagic :: Bool
    , kNix            :: Bool
    } deriving stock (Show, Eq)

me :: Haskeller
me = Haskeller
    { haskellerName = "Veronika"
    , haskellerExperience = 2
    , haskellerKnowledge = Knowledge
        { kSyntax = True
        , kMonads = True
        , kLens = True
        , kTypeLevelMagic = True
        , kNix = False
        }
    }

nameL :: Lens' Haskeller String
nameL = lens haskellerName (\h new -> h { haskellerName = new })
{-# INLINE nameL #-}

knowledgeL :: Lens' Haskeller Knowledge
knowledgeL = lens haskellerKnowledge (\h new -> h { haskellerKnowledge = new })
{-# INLINE knowledgeL #-}

syntaxL :: Lens' Knowledge Bool
syntaxL = lens kSyntax (\k new -> k { kSyntax = new })
{-# INLINE syntaxL #-}

data Grade
    = Mark Int
    | Other String
    deriving stock (Show, Eq)

_Mark :: Prism' Grade Int
_Mark = prism' Mark $ \case
    Mark a -> Just a
    _other -> Nothing
{-# INLINE _Mark #-}

gradeMark :: Grade
gradeMark = Mark 5

gradeOther :: Grade
gradeOther = Other "Satisfactory"

-- Generators

genKnowledge :: (MonadGen m) => m Knowledge
genKnowledge = do
    kSyntax <- Gen.bool
    kMonads <- Gen.bool
    kLens <- Gen.bool
    kTypeLevelMagic <- Gen.bool
    kNix <- Gen.bool
    pure Knowledge{..}

genHaskeller :: (MonadGen m) => m Haskeller
genHaskeller = do
    haskellerName <- genName
    haskellerExperience <- Gen.int $ Range.linear 0 50
    haskellerKnowledge <- genKnowledge
    pure Haskeller{..}

genName :: MonadGen m => m String
genName = Gen.string (Range.linear 1 50) Gen.alphaNum

genInt :: MonadGen m => m Int
genInt = Gen.enumBounded

genFunction :: MonadGen m => m (Int -> Int)
genFunction = genInt >>= \n -> Gen.element
    [ id
    , const n
    , (+ n)
    , (* n)
    , subtract n
    , \x -> if x >= n then 1 else 0
    ]

genFun :: MonadGen m => m (Fun Maybe Int Int)
genFun = genFunction >>= \f -> Gen.element $ map Fun
    [ Just
    , const Nothing
    , Just . f
    ]

genForget :: MonadGen m => m (Forget Int Int a)
genForget = Forget . unFun <$> genFun