ccfd852 · project-m36 · git.iko.soy

git.iko.soy/project-m36

fix loads of unused name warnings in persistent driver

commitccfd852e3eae028108772e6552553e2cb2a5d183 authorAgentM <agentm@themactionfaction.com> dateSat 19 Sep 2015, 22:57 (11 years ago) parent6b30742

2 files changed+46−49

compare with master

unifiedsplit

Database/Persist/ProjectM36.hs+26−29 test/persistent-driver/test.hs+20−20

Database/Persist/ProjectM36.hs+26−29

@@ -18,7 +18,6 @@ import Control.Exception (throw, throwIO)

1818import qualified Data.Text as T

1919import ProjectM36.Atom

2020import Data.Aeson (FromJSON(..), ToJSON(..), withText, withObject, (.:))

21−import qualified Data.HashSet as HS

2221import qualified Data.Map as M

2322import Control.Monad (when)

2423import Data.Maybe (isJust)

@@ -27,7 +26,6 @@ import Control.Monad.Reader (runReaderT)

2726import Web.PathPieces (PathPiece (..))

2827import qualified Database.Persist.Sql as Sql

2928import Control.Monad.Trans.Either

30−import Database.Persist.Class

3129import qualified Database.Persist.Types as DPT

3230import qualified Data.Set as S

3331import qualified Data.Conduit.List as CL

@@ -123,7 +121,10 @@ insertNewRecords uuids records = do

123121 conn <- ask

124122 Trans.liftIO $ executeDatabaseContextExpr conn (insertExpr (ExistingRelation rel))

125123 mapM (\uuid -> keyFromValuesOrDie [PersistText $ T.pack (U.toString uuid)]) uuids

126−

124+

125+throwIOPersistError :: (Trans.MonadIO m) => String -> m a

126+throwIOPersistError msg = Trans.liftIO $ throwIO $ PersistError (T.pack msg)

127+

127128lookupByKey :: forall record m.

128129 (Trans.MonadIO m,

129130 PersistEntity record,

@@ -135,7 +136,7 @@ lookupByKey key = do

135136 conn <- ask

136137 resultRel <- Trans.liftIO $ C.executeRelationalExpr conn query

137138 case resultRel of

138− Left err -> Trans.liftIO $ throwIO $ PersistError "executeRelationExpr error"

139+ Left err -> throwIOPersistError ("executeRelationExpr error: " ++ show err)

139140 Right resultRel' -> case singletonTuple resultRel' of

140141 Nothing -> return Nothing --no match on key

141142 Just tuple -> do

@@ -150,14 +151,14 @@ fromPersistValuesThrow entDef tuple = do

150151 let body = fromPersistValues $ map getValue (entityFields entDef)

151152 getValue field = case atomForAttributeName (unDBName (fieldDB field)) tuple of

152153 Right atom -> atomAsPersistValue atom

153− Left err -> throw $ PersistError "missing field"

154+ Left err -> throw $ PersistError ("missing field: " `T.append` (T.pack $ show err))

154155 keyAtom = atomForAttributeName (unDBName (fieldDB (entityId entDef))) tuple

155156 case keyAtom of

156− Left err -> Trans.liftIO $ throwIO $ PersistError "missing key atom"

157+ Left err -> throwIOPersistError ("missing key atom" ++ show err)

157158 Right keyAtom' -> case keyFromValues [atomAsPersistValue keyAtom'] of

158− Left err -> throw $ PersistError "key failure"

159+ Left err -> throw $ PersistError ("key failure" `T.append` (T.pack $ show err))

159160 Right key -> case body of

160− Left err -> Trans.liftIO $ throwIO $ PersistError err

161+ Left err -> throwIOPersistError (show err)

161162 Right body' -> return $ Entity key body'

162163

163164commonKeyQueryProperties :: (Trans.MonadIO m, PersistEntityBackend val ~ C.Connection, PersistEntity val) => Key val -> ReaderT C.Connection m (RelVarName, RestrictionPredicateExpr)

@@ -202,7 +203,7 @@ updateByKey key updates = do

202203 conn <- ask

203204 maybeErr <- Trans.liftIO $ C.executeDatabaseContextExpr conn query

204205 case maybeErr of

205− Just err -> Trans.liftIO $ throwIO $ PersistError "executeDatabaseExpr error"

206+ Just err -> throwIOPersistError ("executeDatabaseExpr error" ++ show err)

206207 Nothing -> return ()

207208

208209--set the truth unconditionally

@@ -331,7 +332,7 @@ instance PersistConfig C.ConnectionInfo where

331332 createPoolConfig conf = do

332333 connErr <- C.connectProjectM36 conf

333334 case connErr of

334− Left err -> throwIO $ PersistError "Failed to create connection"

335+ Left err -> throwIO $ PersistError ("Failed to create connection: " `T.append` (T.pack $ show err))

335336 Right conn -> return conn

336337 --runPool :: (MonadBaseControl IO m, MonadIO m) => c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a

337338 runPool _ r = runReaderT r

@@ -407,17 +408,16 @@ instance PersistUnique C.Connection where

407408multiFilterAsRestrictionPredicate :: (PersistEntity val, PersistEntityBackend val ~ C.Connection) => Bool -> [Filter val] -> Either RelationalError RestrictionPredicateExpr

408409multiFilterAsRestrictionPredicate _ [] = Right $ TruePredicate

409410multiFilterAsRestrictionPredicate andOr (x:xs) = do

410− let pred = if andOr then AndPredicate else OrPredicate

411+ let predicate = if andOr then AndPredicate else OrPredicate

411412 filtHead <- filterAsRestrictionPredicate x

412413 filtTail <- multiFilterAsRestrictionPredicate andOr xs

413− return $ pred filtHead filtTail

414+ return $ predicate filtHead filtTail

414415

415−filterValueToPersistValues :: forall a. PersistField a => Either a [a] -> [PersistValue]

416+filterValueToPersistValues :: forall a. PersistField a => Either a [a] -> [PersistValue]

416417filterValueToPersistValues v = map toPersistValue $ either return id v

417418

418419filterAsRestrictionPredicate :: (PersistEntity val, PersistEntityBackend val ~ C.Connection) => Filter val -> Either RelationalError RestrictionPredicateExpr

419−filterAsRestrictionPredicate filter = let entDef = entityDef $ dummyFromFilter filter in

420− case filter of

420+filterAsRestrictionPredicate filterIn = case filterIn of

421421 FilterAnd filters -> multiFilterAsRestrictionPredicate True filters

422422 FilterOr filters -> multiFilterAsRestrictionPredicate False filters

423423 BackendFilter _ -> error "BackendFilter not supported"

@@ -432,14 +432,13 @@ filterAsRestrictionPredicate filter = let entDef = entityDef $ dummyFromFilter f

432432 Nothing -> Left $ AtomTypeNotSupported attrName

433433 Just atom' -> Right $ NotPredicate (AttributeEqualityPredicate attrName (NakedAtomExpr atom'))

434434 op -> Left $ AtomOperatorNotSupported $ T.pack (show op)

435− Right vals -> Left $ AtomTypeNotSupported attrName

435+ Right _ -> Left $ AtomTypeNotSupported attrName

436436

437437updateToUpdateTuple :: (PersistEntity val, PersistEntityBackend val ~ C.Connection) => DPT.Update val -> Either RelationalError (AttributeName, Atom)

438438updateToUpdateTuple (BackendUpdate _) = error "BackendUpdate not supported"

439−updateToUpdateTuple up@(DPT.Update field value op) = let entDef = entityDef $ dummyFromUpdate up

440− attrName = unDBName $ fieldDB (persistFieldDef field)

441− atom = persistValueAtom $ toPersistValue value

442− in case op of

439+updateToUpdateTuple (DPT.Update field value op) = let attrName = unDBName $ fieldDB (persistFieldDef field)

440+ atom = persistValueAtom $ toPersistValue value

441+ in case op of

443442 DPT.Assign -> case atom of

444443 Nothing -> Left $ AtomTypeNotSupported attrName

445444 Just atom' -> Right $ (attrName, atom')

@@ -447,10 +446,9 @@ updateToUpdateTuple up@(DPT.Update field value op) = let entDef = entityDef $ du

447446

448447selectionFromRestriction :: (PersistEntity val, PersistEntityBackend val ~ backend, Trans.MonadIO m, backend ~ C.Connection) => [Filter val] -> ReaderT backend m (Either RelationalError RelationalExpr)

449448selectionFromRestriction filters = do

450− conn <- ask

451449 runEitherT $ do

452450 restrictionPredicate <- hoistEither $ multiFilterAsRestrictionPredicate True filters

453− let entDef = entityDef $ dummyFromFilters filters

451+ let entDef = entityDef $ dummyFromFilters filters

454452 relVarName = unDBName $ entityDB entDef

455453 right $ Restrict restrictionPredicate (RelationVariable relVarName)

456454

@@ -471,7 +469,7 @@ instance PersistQuery C.Connection where

471469 Just err -> left err

472470 Nothing -> right ()

473471 case e of

474− Left err -> Trans.liftIO $ throwIO $ PersistError "updateWhere pooped"

472+ Left err -> throwIOPersistError ("updateWhere failure: " ++ show err)

475473 Right () -> return ()

476474

477475 deleteWhere filters = do

@@ -486,7 +484,7 @@ instance PersistQuery C.Connection where

486484 Just err -> left err

487485 Nothing -> right ()

488486 case e of

489− Left err -> Trans.liftIO $ throwIO $ PersistError "deleteWhere pooped"

487+ Left err -> throwIOPersistError ("deleteWhere failure: " ++ show err)

490488 Right () -> return ()

491489

492490 count filters = do

@@ -510,7 +508,7 @@ instance PersistQuery C.Connection where

510508 Right _ -> Trans.liftIO $ throwIO $ PersistError "count returned wrong data type"

511509 Left err -> left err

512510 case e of

513− Left err -> Trans.liftIO $ throwIO $ PersistError "count pooped"

511+ Left err -> throwIOPersistError ("count failure: " ++ show err)

514512 Right c -> return c

515513

516514 --no select options currently supported (sorting, limiting)

@@ -535,18 +533,17 @@ instance PersistQuery C.Connection where

535533 conn <- ask

536534 keys <- runEitherT $ do

537535 restrictionExpr <- (lift $ selectionFromRestriction filters) >>= hoistEither

538− let entDef = entityDef $ dummyFromFilters filters

539− keyAttrNames = ["id"] --no support for multi-attribute keys yet

536+ let keyAttrNames = ["id"] --no support for multi-attribute keys yet

540537 keyExpr = Project (AttributeNames $ S.fromList keyAttrNames) restrictionExpr

541538 (Relation _ tupleSet) <- (Trans.liftIO $ C.executeRelationalExpr conn keyExpr) >>= hoistEither

542539 let keyMapper :: (PersistEntity record, Trans.MonadIO m) => RelationTuple -> EitherT RelationalError (ReaderT C.Connection m) (Key record)

543540 keyMapper tuple = do

544541 atoms <- hoistEither (atomsForAttributeNames (V.fromList keyAttrNames) tuple)

545542 case keyFromValues (map atomAsPersistValue (V.toList atoms)) of

546− Left err -> Trans.liftIO $ throwIO $ PersistError "keyFromValues failure"

543+ Left err -> throwIOPersistError ("keyFromValues failure: " ++ show err)

547544 Right key -> right key

548545 mapM keyMapper $ asList tupleSet

549546 case keys of

550− Left err -> Trans.liftIO $ throwIO $ PersistError "keyFromValues failure2"

547+ Left err -> throwIOPersistError ("keyFromValues failure2: " ++ show err)

551548 Right keys' -> return $ return (CL.sourceList keys')

552549

test/persistent-driver/test.hs+20−20

@@ -34,7 +34,7 @@ testList :: Test

3434testList = TestList $ map mkInProcessTest [testGetBy, testDelete, testUpdate, testCount, testSelect, testSelectKeys]

3535

3636main :: IO ()

37−main = do

37+main = do

3838 tcounts <- runTestTT testList

3939 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

4040

@@ -70,11 +70,11 @@ testGetBy :: ReaderT ProjectM36Backend IO ()

7070testGetBy = do

7171 let name = "Michael"

7272 age = 26

73− m <- insert $ Person name age

73+ _ <- insert $ Person name age

7474 michael <- getBy $ UniqueName name

75− michael <- liftIO $ entityFromMaybe michael

76− liftIO $ assertEqual "name equality" name (personName $ entityVal michael)

77− liftIO $ assertEqual "age equality" age (personAge $ entityVal michael)

75+ michael' <- liftIO $ entityFromMaybe michael

76+ liftIO $ assertEqual "name equality" name (personName $ entityVal michael')

77+ liftIO $ assertEqual "age equality" age (personAge $ entityVal michael')

7878 return ()

7979

8080--insert two people, delete one, check one remains

@@ -84,24 +84,24 @@ testDelete = do

8484 age1 = 26

8585 name2 = "John"

8686 age2 = 30

87− m1 <- insert $ Person name1 age1

87+ _ <- insert $ Person name1 age1

8888 m2 <- insert $ Person name2 age2

8989 deleteBy $ UniqueName name1 --delete michael

9090 nom1 <- getBy $ UniqueName name1

9191 --check that m1 was deleted

9292 case nom1 of

93− Just m -> liftIO $ assertFailure "deleteBy failure"

93+ Just _ -> liftIO $ assertFailure "deleteBy failure"

9494 Nothing -> return ()

9595 --check that m2 still exists

9696 m2check <- getBy $ UniqueName name2

9797 case m2check of

9898 Nothing -> liftIO $ assertFailure "deleteBy failure2"

99− Just m -> return ()

99+ Just _ -> return ()

100100 --delete m2

101101 deleteWhere [PersonName ==. name2]

102102 m2del <- get m2

103103 case m2del of

104− Just m -> liftIO $ assertFailure "deleteBy failure m2"

104+ Just _ -> liftIO $ assertFailure "deleteBy failure m2"

105105 Nothing -> return ()

106106 return ()

107107

@@ -118,13 +118,13 @@ testUpdate = do

118118 update m1 [PersonAge =. 35] -- update m1's age

119119 updateWhere [PersonName ==. name2] [PersonName =. name3] --update m2's name

120120 m1up <- get m1

121− m1up <- liftIO $ valFromMaybe m1up

121+ m1up' <- liftIO $ valFromMaybe m1up

122122 m2up <- get m2

123− m2up <- liftIO $ valFromMaybe m2up

124− liftIO $ assertEqual "m1 update" name1 (personName m1up)

125− liftIO $ assertEqual "m1 update" 35 (personAge m1up)

126− liftIO $ assertEqual "m2 update" name3 (personName m2up)

127− liftIO $ assertEqual "m2 update" age2 (personAge m2up)

123+ m2up' <- liftIO $ valFromMaybe m2up

124+ liftIO $ assertEqual "m1 update" name1 (personName m1up')

125+ liftIO $ assertEqual "m1 update" 35 (personAge m1up')

126+ liftIO $ assertEqual "m2 update" name3 (personName m2up')

127+ liftIO $ assertEqual "m2 update" age2 (personAge m2up')

128128 return ()

129129

130130testCount :: ReaderT ProjectM36Backend IO ()

@@ -133,8 +133,8 @@ testCount = do

133133 age1 = 26

134134 name2 = "John"

135135 age2 = 30

136− m1 <- insert $ Person name1 age1

137− m2 <- insert $ Person name2 age2

136+ _ <- insert $ Person name1 age1

137+ _ <- insert $ Person name2 age2

138138 c1 <- count [PersonAge ==. 26]

139139 liftIO $ assertEqual "count age" 1 c1

140140 c2 <- count [PersonAge !=. 400]

@@ -148,8 +148,8 @@ testSelect = do

148148 age1 = 26

149149 name2 = "John"

150150 age2 = 30

151− m1 <- insert $ Person name1 age1

152− m2 <- insert $ Person name2 age2

151+ _ <- insert $ Person name1 age1

152+ _ <- insert $ Person name2 age2

153153 name1List <- selectList [PersonName ==. name1] []

154154 liftIO $ assertEqual "select name1 len" 1 (length name1List)

155155 liftIO $ assertEqual "select name1 val" name1 ((personName . entityVal . head) name1List)

@@ -162,7 +162,7 @@ testSelectKeys = do

162162 age1 = 26

163163 name2 = "John"

164164 age2 = 30

165− m1 <- insert $ Person name1 age1

165+ _ <- insert $ Person name1 age1

166166 m2 <- insert $ Person name2 age2

167167 keysList <- selectKeysList [PersonAge ==. age2] []

168168 liftIO $ assertEqual "select keysList len" 1 (length keysList)