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.Meta
Control.Avatar
Classes.DatabaseRepresentation
Classes.ToDatabase
Classes.FromDatabase

View file

@ -4,3 +4,4 @@ module Classes
import Classes.FromDatabase 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 #-}
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 #-}
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)
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) =
(pid, ts, amount, price, ver)
instance FromDatabase Amount where
type OutTuple Amount = (Int, UTCTime, Int, Int, Bool)
fromDatabase (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)) =
-- (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) =
AuthInfo (decodeUtf8 <$> mChallenge) (AuthTicket $ decodeUtf8 ticket)
@ -154,9 +156,11 @@ data Token = Token
-- toDatabase (Token string usr exp 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) =
Token (decodeUtf8 string) usr expiry (toEnum method)
@ -194,9 +198,11 @@ data AuthData = AuthData
-- toDatabase (AuthData id_ usr method comm 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) =
AuthData id_ usr (toEnum method) comm (decodeUtf8 payload) (decodeUtf8 salt)
@ -223,9 +229,11 @@ instance ToSchema AuthOverview
-- toDatabase (AuthOverview id_ comm 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) =
AuthOverview id_ uid comm (toEnum method)

View file

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

View file

@ -36,19 +36,18 @@ instance ToJSON Product where
instance FromJSON 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)
instance ToDatabase Product where
toDatabase (Product id_ ident ml maid msid maxa mina apc ppc artnr) =
(id_, ident, ml, maid, msid, maxa, mina, apc, ppc, artnr)
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) =
Product id_ ident ml maid msid maxa mina apc ppc artnr

View file

@ -9,8 +9,7 @@ import GHC.Generics
-- internal imports
import Classes.ToDatabase
import Classes.FromDatabase
import Classes
data Role = Role
{ roleID :: Int
@ -37,19 +36,18 @@ instance ToJSON Role where
instance FromJSON 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)
instance ToDatabase Role where
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)
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) =
Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10

View file

@ -13,14 +13,14 @@ data Settings = Settings
}
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)
instance FromDatabase Settings where
type OutTuple Settings = (Bool, T.Text)
fromDatabase (reg, imprint) = Settings reg imprint

View file

@ -28,17 +28,17 @@ data User
}
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) =
(id_, ident, bal, ts, email, ava)
instance FromDatabase User where
type OutTuple User = (Int, T.Text, Int, Day, Maybe T.Text, Maybe Int)
fromDatabase (id_, ident, bal, ts, email, ava) =
User id_ ident bal ts email ava