sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 15:44:51 +09:00
Code Issues Activity

Adapt to switch to typed default/fill values in persistent-migration

Browse source
This commit is contained in:
fr33domlover 2018-04-03 01:20:24 +00:00
parent 7c2faa7faa
commit ec28256de5
1 changed files with 20 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
src/Vervis/Migration.hs
View file

@ -25,11 +25,14 @@ import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Data.ByteString (ByteString)
--import Text.Email.QuasiQuotation (email)
import Text.Email.Validate (unsafeEmailAddress)
import Data.Foldable (traverse_, for_)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Proxy
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..))
import Database.Persist
import Database.Persist.BackendDataType (backendDataType)
import Database.Persist.Migration
@ -49,6 +52,9 @@ import Vervis.Model.Workflow
type Apply m = SchemaT SqlBackend m ()
type Mig m = Migration SqlBackend m
defaultTime :: UTCTime
defaultTime = UTCTime (ModifiedJulianDay 0) 0
withPrepare :: Monad m => Mig m -> Apply m -> Mig m
withPrepare (validate, apply) prepare = (validate, prepare >> apply)
@ -67,10 +73,7 @@ changes =
-- 6
, removeField "Ticket" "done"
-- 7
, addField "Ticket" (Just "'TSNew'") $ Field
"status"
(FTPrim $ backendDataType (Proxy :: Proxy Text))
FieldRequired
, addFieldPrimRequired "Ticket" ("TSNew" :: Text) "status"
-- 8
, unchecked $ traverse_ U.addEntity model_2016_09_01_just_workflow
-- 9
@ -78,10 +81,10 @@ changes =
-- 10
, let key = fromBackendKey defaultBackendKey :: Key Workflow2016
in withPrepare
(addField "Project" (Just $ toPathPiece key) $ Field
(addFieldRefRequired "Project"
(toBackendKey key)
"workflow"
(FTRef "Workflow")
FieldRequired
"Workflow"
) $ do
noProjects <- lift $
null <$> selectKeysList [] [LimitTo 1 :: SelectOpt Project]
@ -94,50 +97,28 @@ changes =
w = Workflow2016 sid ident Nothing Nothing WSPublic
insertKey key w
-- 11
, addField "Workflow"
(Just "'WSSharer'")
(Field
"scope"
(FTPrim $ backendDataType (Proxy :: Proxy Text))
FieldRequired
)
, addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope"
-- 12
, changeFieldType "Person" "hash" $
backendDataType (Proxy :: Proxy ByteString)
-- 13
, unsetFieldMaybe "Person" "email" "'no@email'"
--, unsetFieldPrimMaybe "Person" "email" [email|noreply@no.such.email|]
, unsetFieldPrimMaybe "Person" "email" $
unsafeEmailAddress "noreply" "no.such.email"
-- 14
, addField "Person" (Just "TRUE") Field
{ fieldName = "verified"
, fieldType = FTPrim $ backendDataType (Proxy :: Proxy Bool)
, fieldMaybe = FieldRequired
}
, addFieldPrimRequired "Person" True "verified"
-- 15
, addField "Person" (Just "''") Field
{ fieldName = "verifiedKey"
, fieldType = FTPrim $ backendDataType (Proxy :: Proxy Text)
, fieldMaybe = FieldRequired
}
, addFieldPrimRequired "Person" ("" :: Text) "verifiedKey"
-- 16
, addField "Person" (Just "''") Field
{ fieldName = "resetPassphraseKey"
, fieldType = FTPrim $ backendDataType (Proxy :: Proxy Text)
, fieldMaybe = FieldRequired
}
, addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey"
-- 17
, renameField "Person" "hash" "passphraseHash"
-- 18
, renameField "Person" "resetPassphraseKey" "resetPassKey"
-- 19
, addField "Person" (Just "'1970-01-01 00:00:00'") $ Field
"verifiedKeyCreated"
(FTPrim $ backendDataType (Proxy :: Proxy UTCTime))
FieldRequired
, addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated"
-- 20
, addField "Person" (Just "'1970-01-01 00:00:00'") $ Field
"resetPassKeyCreated"
(FTPrim $ backendDataType (Proxy :: Proxy UTCTime))
FieldRequired
, addFieldPrimRequired "Person" defaultTime "resetPassKeyCreated"
]
migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int))