invent DatabaseRepresentation tyeclass and apply it

This commit is contained in:
nek0 2022-07-24 15:26:55 +02:00
parent 80f68bf86c
commit cc54dc5314
12 changed files with 67 additions and 42 deletions

View file

@ -64,6 +64,7 @@ library
Control.Journal Control.Journal
Control.Meta Control.Meta
Control.Avatar Control.Avatar
Classes.DatabaseRepresentation
Classes.ToDatabase Classes.ToDatabase
Classes.FromDatabase Classes.FromDatabase

View file

@ -4,3 +4,4 @@ module Classes
import Classes.FromDatabase as C import Classes.FromDatabase as C
import Classes.ToDatabase as C import Classes.ToDatabase as C
import Classes.DatabaseRepresentation as C

View file

@ -0,0 +1,8 @@
{-# LANGUAGE TypeFamilies #-}
module Classes.DatabaseRepresentation where
import Data.Kind (Type)
class DatabaseRepresentation a where
type Representation a :: Type

View file

@ -1,10 +1,12 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Classes.FromDatabase where module Classes.FromDatabase where
import Data.Kind (Type) -- internal imports
class FromDatabase a where import Classes.DatabaseRepresentation
type OutTuple a :: Type class DatabaseRepresentation a => FromDatabase a where
fromDatabase :: OutTuple a -> a -- type OutTuple a :: Type
fromDatabase :: Representation a -> a

View file

@ -1,10 +1,12 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Classes.ToDatabase where module Classes.ToDatabase where
import Data.Kind (Type) -- internal imports
class ToDatabase a where import Classes.DatabaseRepresentation
type InTuple a :: Type class DatabaseRepresentation a => ToDatabase a where
toDatabase :: a -> InTuple a -- type InTuple a :: Type
toDatabase :: a -> Representation a

View file

@ -48,16 +48,16 @@ data Amount = Amount
} }
deriving (Show) deriving (Show)
instance ToDatabase Amount where instance DatabaseRepresentation Amount where
type InTuple Amount = (Int, UTCTime, Int, Int, Bool) type Representation Amount = (Int, UTCTime, Int, Int, Bool)
instance ToDatabase Amount where
toDatabase (Amount pid ts amount price ver) = toDatabase (Amount pid ts amount price ver) =
(pid, ts, amount, price, ver) (pid, ts, amount, price, ver)
instance FromDatabase Amount where instance FromDatabase Amount where
type OutTuple Amount = (Int, UTCTime, Int, Int, Bool)
fromDatabase (pid, ts, amount, price, ver) = fromDatabase (pid, ts, amount, price, ver) =
Amount pid ts amount price ver Amount pid ts amount price ver

View file

@ -55,9 +55,11 @@ instance ToSchema AuthInfo
-- toDatabase (AuthInfo mChallenge (AuthTicket ticket)) = -- toDatabase (AuthInfo mChallenge (AuthTicket ticket)) =
-- (mChallenge, ticket) -- (mChallenge, ticket)
instance FromDatabase AuthInfo where instance DatabaseRepresentation AuthInfo where
type OutTuple AuthInfo = (Maybe ByteString, ByteString) type Representation AuthInfo = (Maybe ByteString, ByteString)
instance FromDatabase AuthInfo where
fromDatabase (mChallenge, ticket) = fromDatabase (mChallenge, ticket) =
AuthInfo (decodeUtf8 <$> mChallenge) (AuthTicket $ decodeUtf8 ticket) AuthInfo (decodeUtf8 <$> mChallenge) (AuthTicket $ decodeUtf8 ticket)
@ -154,9 +156,11 @@ data Token = Token
-- toDatabase (Token string usr exp method) = -- toDatabase (Token string usr exp method) =
-- (string, usr, exp, fromEnum method) -- (string, usr, exp, fromEnum method)
instance FromDatabase Token where instance DatabaseRepresentation Token where
type OutTuple Token = (ByteString, Int, UTCTime, Int) type Representation Token = (ByteString, Int, UTCTime, Int)
instance FromDatabase Token where
fromDatabase (string, usr, expiry, method) = fromDatabase (string, usr, expiry, method) =
Token (decodeUtf8 string) usr expiry (toEnum method) Token (decodeUtf8 string) usr expiry (toEnum method)
@ -194,9 +198,11 @@ data AuthData = AuthData
-- toDatabase (AuthData id_ usr method comm payload) = -- toDatabase (AuthData id_ usr method comm payload) =
-- (id_, usr, fromEnum method, comm, (B64.decode $ encodeUtf8 payload)) -- (id_, usr, fromEnum method, comm, (B64.decode $ encodeUtf8 payload))
instance FromDatabase AuthData where instance DatabaseRepresentation AuthData where
type OutTuple AuthData = (Int, Int, Int, T.Text, ByteString, ByteString) type Representation AuthData = (Int, Int, Int, T.Text, ByteString, ByteString)
instance FromDatabase AuthData where
fromDatabase (id_, usr, method, comm, payload, salt) = fromDatabase (id_, usr, method, comm, payload, salt) =
AuthData id_ usr (toEnum method) comm (decodeUtf8 payload) (decodeUtf8 salt) AuthData id_ usr (toEnum method) comm (decodeUtf8 payload) (decodeUtf8 salt)
@ -223,9 +229,11 @@ instance ToSchema AuthOverview
-- toDatabase (AuthOverview id_ comm method) = -- toDatabase (AuthOverview id_ comm method) =
-- (id_, comm, fromEnum method) -- (id_, comm, fromEnum method)
instance FromDatabase AuthOverview where instance DatabaseRepresentation AuthOverview where
type OutTuple AuthOverview = (Int, Int, T.Text, Int) type Representation AuthOverview = (Int, Int, T.Text, Int)
instance FromDatabase AuthOverview where
fromDatabase (id_, uid, comm, method) = fromDatabase (id_, uid, comm, method) =
AuthOverview id_ uid comm (toEnum method) AuthOverview id_ uid comm (toEnum method)

View file

@ -31,8 +31,11 @@ instance ToJSON Avatar where
instance FromJSON Avatar instance FromJSON Avatar
instance ToSchema Avatar instance ToSchema Avatar
instance DatabaseRepresentation Avatar where
type Representation Avatar = (Int, T.Text, ByteString, ByteString)
instance FromDatabase Avatar where instance FromDatabase Avatar where
type OutTuple Avatar = (Int, T.Text, ByteString, ByteString)
fromDatabase (id_, name, hash, data_) = fromDatabase (id_, name, hash, data_) =
Avatar id_ name (decodeUtf8 hash) (unpack data_) Avatar id_ name (decodeUtf8 hash) (unpack data_)
@ -50,8 +53,11 @@ instance ToJSON AvatarData where
instance FromJSON AvatarData instance FromJSON AvatarData
instance ToSchema AvatarData instance ToSchema AvatarData
instance DatabaseRepresentation AvatarData where
type Representation AvatarData = (T.Text, ByteString)
instance FromDatabase AvatarData where instance FromDatabase AvatarData where
type OutTuple AvatarData = (T.Text, ByteString)
fromDatabase (name, data_) = fromDatabase (name, data_) =
AvatarData name (unpack data_) AvatarData name (unpack data_)

View file

@ -36,19 +36,18 @@ instance ToJSON Product where
instance FromJSON Product instance FromJSON Product
instance ToSchema Product instance ToSchema Product
instance ToDatabase Product where instance DatabaseRepresentation Product where
type InTuple Product = type Representation Product =
(Int, T.Text, Int, Maybe Int, Maybe Int, Int, Int, Int, Maybe Int, Maybe T.Text) (Int, T.Text, Int, Maybe Int, Maybe Int, Int, Int, Int, Maybe Int, Maybe T.Text)
instance ToDatabase Product where
toDatabase (Product id_ ident ml maid msid maxa mina apc ppc artnr) = toDatabase (Product id_ ident ml maid msid maxa mina apc ppc artnr) =
(id_, ident, ml, maid, msid, maxa, mina, apc, ppc, artnr) (id_, ident, ml, maid, msid, maxa, mina, apc, ppc, artnr)
instance FromDatabase Product where instance FromDatabase Product where
type OutTuple Product =
(Int, T.Text, Int, Maybe Int, Maybe Int, Int, Int, Int, Maybe Int, Maybe T.Text)
fromDatabase (id_, ident, ml, maid, msid, maxa, mina, apc, ppc, artnr) = fromDatabase (id_, ident, ml, maid, msid, maxa, mina, apc, ppc, artnr) =
Product id_ ident ml maid msid maxa mina apc ppc artnr Product id_ ident ml maid msid maxa mina apc ppc artnr

View file

@ -9,8 +9,7 @@ import GHC.Generics
-- internal imports -- internal imports
import Classes.ToDatabase import Classes
import Classes.FromDatabase
data Role = Role data Role = Role
{ roleID :: Int { roleID :: Int
@ -37,19 +36,18 @@ instance ToJSON Role where
instance FromJSON Role instance FromJSON Role
instance ToSchema Role instance ToSchema Role
instance ToDatabase Role where instance DatabaseRepresentation Role where
type InTuple Role = type Representation Role =
(Int, T.Text, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) (Int, T.Text, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
instance ToDatabase Role where
toDatabase (Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10) = toDatabase (Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10) =
(id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10) (id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)
instance FromDatabase Role where instance FromDatabase Role where
type OutTuple Role =
(Int, T.Text, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
fromDatabase (id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10) = fromDatabase (id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10) =
Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10

View file

@ -13,14 +13,14 @@ data Settings = Settings
} }
deriving (Show) deriving (Show)
instance ToDatabase Settings where instance DatabaseRepresentation Settings where
type InTuple Settings = (Bool, T.Text) type Representation Settings = (Bool, T.Text)
instance ToDatabase Settings where
toDatabase (Settings reg imprint) = (reg, imprint) toDatabase (Settings reg imprint) = (reg, imprint)
instance FromDatabase Settings where instance FromDatabase Settings where
type OutTuple Settings = (Bool, T.Text)
fromDatabase (reg, imprint) = Settings reg imprint fromDatabase (reg, imprint) = Settings reg imprint

View file

@ -28,17 +28,17 @@ data User
} }
deriving (Generic, Show) deriving (Generic, Show)
instance ToDatabase User where instance DatabaseRepresentation User where
type InTuple User = (Int, T.Text, Int, Day, Maybe T.Text, Maybe Int) type Representation User = (Int, T.Text, Int, Day, Maybe T.Text, Maybe Int)
instance ToDatabase User where
toDatabase (User id_ ident bal ts email ava) = toDatabase (User id_ ident bal ts email ava) =
(id_, ident, bal, ts, email, ava) (id_, ident, bal, ts, email, ava)
instance FromDatabase User where instance FromDatabase User where
type OutTuple User = (Int, T.Text, Int, Day, Maybe T.Text, Maybe Int)
fromDatabase (id_, ident, bal, ts, email, ava) = fromDatabase (id_, ident, bal, ts, email, ava) =
User id_ ident bal ts email ava User id_ ident bal ts email ava