gistfile1.hs

-- Initialize a random database with languages, and keep track of what languages
-- are available.
instance Arbitrary (DBState (LoadedEntity Language)) where
  arbitrary = do
    l <- Language <$> (T.pack <$> name) <*> name `suchThat` (not . null)
    return $ DBState (void $ insertLanguage l) (toEnt l)
    where insertLanguage l = HDBC.run "INSERT INTO language (iso_code, name) VALUES (?, ?)"
                               [ toSql $ languageIsoCode l
                               , toSql $ languageName l ]
          toEnt l = Entity { entityRef = Ref (toSql $ languageIsoCode l)
                           , entityInfo = l }

prop_allLanguages = monadicIO $ do
  states <- setBy (entityRef . entity) <$> pick arbitrary
  let languages = entity `map` states
  fetched <- run $ databaseTest $ initDb `mapM` states >> allLanguages
  assert $ languages `eqSet` fetched
  where eqSet a b = all (`elem` a) b && all (`elem` b) a

prop_getByPk = monadicIO $ do
  states <- setBy (entityRef . entity) <$> pick (listOf1 arbitrary :: Gen [DBState (LoadedEntity Language)])
  let language = head $ entity `map` states
  fetched <- run $ databaseTest $ initDb `mapM` states >> getByPk (entityRef language)
  assert $ language == fetched