invent DatabaseRepresentation tyeclass and apply it

mateamt.cabal

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

src/Classes.hs

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

src/Classes/DatabaseRepresentation.hs

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

src/Classes/FromDatabase.hs

@@ -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

src/Classes/ToDatabase.hs

@@ -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

src/Types/Amount.hs

@@ -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

src/Types/Auth.hs

@@ -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)

src/Types/Avatar.hs

@@ -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_)

src/Types/Product.hs

@@ -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
 

src/Types/Role.hs

@@ -9,8 +9,7 @@ import GHC.Generics
 
 -- internal imports
 
-import Classes.ToDatabase
+import Classes
-import Classes.FromDatabase
 
 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
 

src/Types/Settings.hs

@@ -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

src/Types/User.hs

@@ -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