itemfield-1.2.3.0: test/TestDataGen.hs

module TestDataGen where

import Data.Monoid
import Test.QuickCheck
import qualified Data.Text as T
import TextUI.ItemField


instance Arbitrary Items where
    arbitrary = return . head =<< gen_items 1

    shrink (ItemGroup _ i) = shrink i
    shrink (Items n) = map Items $ shrink n


instance Arbitrary ItemState where
    arbitrary = elements [Free, Marked, Good, Bad, Pending]


-- Convenience quickcheck generatable input.  Last field is total item count.
data BoundedItems = BoundedItems [Items] Int
                  deriving Show

numBounded (BoundedItems _ n) = n


instance Arbitrary BoundedItems where
    arbitrary = sized $ \s ->
                do ttl <- choose (0, s `min` 5000)
                   itms <- gen_items ttl
                   return $ BoundedItems itms ttl
    shrink (BoundedItems i n) = [BoundedItems i' (cntItems i') | i' <- shrink i]


gen_items n =
    do cnt <- choose (0, n)
       grp <- choose (0, 5 :: Int)
       let ii = if grp == 0
                then (Items cnt)
                else foldl addGrp (Items cnt) [0 .. grp]
           remcnt = n - cnt
       remitems <- if remcnt > 0
                   then gen_items remcnt
                   else return []
       return $ ii : remitems
    where addGrp i g = ItemGroup (T.pack $ "grp" <> show g) i


-- Convenience quickcheck generatable input with random state for each
-- item.  Last field is total item count.
data BoundedStateItems = BoundedStateItems [Items] [ItemState] Int
                  deriving Show


instance Arbitrary BoundedStateItems where
    arbitrary = do (BoundedItems items cnt) <- arbitrary
                   st8 <- vectorOf cnt arbitrary
                   return $ BoundedStateItems items st8 cnt
    shrink (BoundedStateItems i s n) =
        let newBSI n = BoundedStateItems n (take (cntItems n) s) (cntItems n)
        in [ newBSI i' | i' <- shrink i ]


instance Arbitrary ItemField where
    arbitrary = sized $ \s ->
                do ttl <- choose (0, s `min` 5000)
                   i <- gen_items ttl
                   s <- vectorOf ttl arbitrary
                   c <- choose (0, max 0 $ ttl - 1)
                   f <- elements [Nothing, Just $ const $ const $ T.pack "item"]
                   return $ ItemFld c i s f

    shrink i =
        let newfld x = ItemFld (newsel x) x (newst8 x) (elemIdent i)
            newsel x = curSel i `max` (cntItems x - 1)
            newst8 x = take (cntItems x) $ itemst8 i
        in [newfld i' | i' <- shrink (items i) ]