chore(profiling): remove all newtype-deriv PersistFieldSql instances

This commit is contained in:
Gregor Kleen 2021-02-02 19:47:48 +01:00
parent c90dcba1a7
commit 09ce1bb035
6 changed files with 49 additions and 15 deletions

View File

@ -326,7 +326,10 @@ derivePersistFieldJSON ''ExamGradingRule
newtype ExamPassed = ExamPassed { examPassed :: Bool } newtype ExamPassed = ExamPassed { examPassed :: Bool }
deriving (Read, Show, Generic, Typeable) deriving (Read, Show, Generic, Typeable)
deriving newtype (Eq, Ord, Enum, Bounded, PersistField, PersistFieldSql) deriving newtype (Eq, Ord, Enum, Bounded, PersistField)
instance PersistFieldSql ExamPassed where
sqlType _ = sqlType $ Proxy @Bool
deriveFinite ''ExamPassed deriveFinite ''ExamPassed
finitePathPiece ''ExamPassed ["failed", "passed"] finitePathPiece ''ExamPassed ["failed", "passed"]

View File

@ -19,7 +19,7 @@ module Model.Types.File
import Import.NoModel import Import.NoModel
import Database.Persist.Sql (PersistFieldSql) import Database.Persist.Sql (PersistFieldSql(..))
import Web.HttpApiData (ToHttpApiData, FromHttpApiData) import Web.HttpApiData (ToHttpApiData, FromHttpApiData)
import Data.ByteArray (ByteArrayAccess) import Data.ByteArray (ByteArrayAccess)
@ -42,24 +42,30 @@ import qualified Data.Map as Map
newtype FileContentChunkReference = FileContentChunkReference (Digest SHA3_512) newtype FileContentChunkReference = FileContentChunkReference (Digest SHA3_512)
deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
deriving newtype ( PersistField, PersistFieldSql deriving newtype ( PersistField
, PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
, Hashable, NFData , Hashable, NFData
, ByteArrayAccess , ByteArrayAccess
, Binary , Binary
) )
instance PersistFieldSql FileContentChunkReference where
sqlType _ = sqlType $ Proxy @(Digest SHA3_512)
makeWrapped ''FileContentChunkReference makeWrapped ''FileContentChunkReference
newtype FileContentReference = FileContentReference (Digest SHA3_512) newtype FileContentReference = FileContentReference (Digest SHA3_512)
deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
deriving newtype ( PersistField, PersistFieldSql deriving newtype ( PersistField
, PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
, Hashable, NFData , Hashable, NFData
, ByteArrayAccess , ByteArrayAccess
, Binary , Binary
) )
instance PersistFieldSql FileContentReference where
sqlType _ = sqlType $ Proxy @(Digest SHA3_512)
makeWrapped ''FileContentReference makeWrapped ''FileContentReference

View File

@ -19,7 +19,7 @@ import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Crypto.Hash (digestFromByteString, SHAKE128) import Crypto.Hash (digestFromByteString, SHAKE128)
import Database.Persist.Sql (PersistFieldSql) import Database.Persist.Sql (PersistFieldSql(..))
import Data.ByteArray (ByteArrayAccess) import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA import qualified Data.ByteArray as BA
@ -102,11 +102,14 @@ derivePersistFieldJSON ''NotificationSettings
newtype BounceSecret = BounceSecret (Digest (SHAKE128 64)) newtype BounceSecret = BounceSecret (Digest (SHAKE128 64))
deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
deriving newtype ( PersistField, PersistFieldSql deriving newtype ( PersistField
, Hashable, NFData , Hashable, NFData
, ByteArrayAccess , ByteArrayAccess
) )
instance PersistFieldSql BounceSecret where
sqlType _ = sqlType $ Proxy @(Digest (SHAKE128 64))
instance PathPiece BounceSecret where instance PathPiece BounceSecret where
toPathPiece = CI.foldCase . encodeBase32Unpadded . BA.convert toPathPiece = CI.foldCase . encodeBase32Unpadded . BA.convert
fromPathPiece = fmap BounceSecret . digestFromByteString <=< either (const Nothing) Just . decodeBase32Unpadded . encodeUtf8 fromPathPiece = fmap BounceSecret . digestFromByteString <=< either (const Nothing) Just . decodeBase32Unpadded . encodeUtf8
@ -120,10 +123,13 @@ derivePersistFieldJSON ''MailContent
newtype MailContentReference = MailContentReference (Digest SHA3_512) newtype MailContentReference = MailContentReference (Digest SHA3_512)
deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
deriving newtype ( PersistField, PersistFieldSql deriving newtype ( PersistField
, PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
, Hashable, NFData , Hashable, NFData
, ByteArrayAccess , ByteArrayAccess
) )
instance PersistFieldSql MailContentReference where
sqlType _ = sqlType $ Proxy @(Digest SHA3_512)
derivePersistFieldJSON ''MailHeaders derivePersistFieldJSON ''MailHeaders

View File

@ -54,9 +54,12 @@ type PseudonymWord = CI Text
newtype Pseudonym = Pseudonym Word24 newtype Pseudonym = Pseudonym Word24
deriving (Eq, Ord, Read, Show, Generic, Data) deriving (Eq, Ord, Read, Show, Generic, Data)
deriving newtype ( Bounded, Enum, Integral, Num, Real, Ix deriving newtype ( Bounded, Enum, Integral, Num, Real, Ix
, PersistField, PersistFieldSql, Random , PersistField, Random
) )
instance PersistFieldSql Pseudonym where
sqlType _ = sqlType $ Proxy @Word24
instance FromJSON Pseudonym where instance FromJSON Pseudonym where
parseJSON v@(Aeson.Number _) = do parseJSON v@(Aeson.Number _) = do
w <- parseJSON v :: Aeson.Parser Word32 w <- parseJSON v :: Aeson.Parser Word32

View File

@ -81,18 +81,24 @@ deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (W
newtype WorkflowGraphReference = WorkflowGraphReference (Digest SHA3_256) newtype WorkflowGraphReference = WorkflowGraphReference (Digest SHA3_256)
deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
deriving newtype ( PersistField, PersistFieldSql deriving newtype ( PersistField
, PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
, Hashable, NFData , Hashable, NFData
, ByteArrayAccess , ByteArrayAccess
, Binary , Binary
) )
instance PersistFieldSql WorkflowGraphReference where
sqlType _ = sqlType $ Proxy @(Digest SHA3_256)
----- WORKFLOW GRAPH: NODES ----- ----- WORKFLOW GRAPH: NODES -----
newtype WorkflowGraphNodeLabel = WorkflowGraphNodeLabel { unWorkflowGraphNodeLabel :: CI Text } newtype WorkflowGraphNodeLabel = WorkflowGraphNodeLabel { unWorkflowGraphNodeLabel :: CI Text }
deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable) deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary) deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, Binary)
instance PersistFieldSql WorkflowGraphNodeLabel where
sqlType _ = sqlType $ Proxy @(CI Text)
data WorkflowGraphNode fileid userid = WGN data WorkflowGraphNode fileid userid = WGN
{ wgnFinal :: Maybe Icon { wgnFinal :: Maybe Icon
@ -123,7 +129,10 @@ data WorkflowNodeMessage userid = WorkflowNodeMessage
newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel { unWorkflowGraphEdgeLabel :: CI Text } newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel { unWorkflowGraphEdgeLabel :: CI Text }
deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable) deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary) deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, Binary)
instance PersistFieldSql WorkflowGraphEdgeLabel where
sqlType _ = sqlType $ Proxy @(CI Text)
data WorkflowGraphRestriction data WorkflowGraphRestriction
= WorkflowGraphRestrictionPayloadFilled { wgrPayloadFilled :: WorkflowPayloadLabel } = WorkflowGraphRestrictionPayloadFilled { wgrPayloadFilled :: WorkflowPayloadLabel }
@ -352,7 +361,10 @@ classifyWorkflowScope = \case
newtype WorkflowPayloadLabel = WorkflowPayloadLabel { unWorkflowPayloadLabel :: CI Text } newtype WorkflowPayloadLabel = WorkflowPayloadLabel { unWorkflowPayloadLabel :: CI Text }
deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable) deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable)
deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, PersistFieldSql, Binary) deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, Binary)
instance PersistFieldSql WorkflowPayloadLabel where
sqlType _ = sqlType $ Proxy @(CI Text)
newtype WorkflowStateIndex = WorkflowStateIndex { unWorkflowStateIndex :: Word64 } newtype WorkflowStateIndex = WorkflowStateIndex { unWorkflowStateIndex :: Word64 }
deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable) deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable)

View File

@ -16,8 +16,9 @@ module Utils.DateTime
, day , day
) where ) where
import ClassyPrelude.Yesod hiding (lift) import ClassyPrelude.Yesod hiding (lift, Proxy(..))
import System.Locale.Read import System.Locale.Read
import Data.Proxy
import Data.Time (NominalDiffTime, nominalDay, LocalTime(..), TimeOfDay, midnight, ZonedTime(..), DiffTime) import Data.Time (NominalDiffTime, nominalDay, LocalTime(..), TimeOfDay, midnight, ZonedTime(..), DiffTime)
import Data.Time.Zones as Zones (TZ) import Data.Time.Zones as Zones (TZ)
@ -38,7 +39,7 @@ import Instances.TH.Lift ()
import Data.Data (Data) import Data.Data (Data)
import Data.Universe import Data.Universe
import Database.Persist.Sql (PersistFieldSql) import Database.Persist.Sql (PersistFieldSql(..))
import Utils.PathPiece import Utils.PathPiece
@ -98,7 +99,10 @@ instance HasLocalTime TimeOfDay where
newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String } newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String }
deriving (Eq, Ord, Read, Show, Data, Generic, Typeable) deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
deriving newtype (ToJSON, FromJSON, PersistField, PersistFieldSql, IsString) deriving newtype (ToJSON, FromJSON, PersistField, IsString)
instance PersistFieldSql DateTimeFormat where
sqlType _ = sqlType $ Proxy @String
instance Hashable DateTimeFormat instance Hashable DateTimeFormat