[FIX] merge
[gargantext.git] / src / Gargantext / Database / Schema / User.hs
index b5bdb362e53467bc920baf0882ea7cf472905b2b..32a3a0e766e88a0345f634be54ddfe64c61ade4b 100644 (file)
@@ -10,58 +10,61 @@ Portability : POSIX
 Functions to deal with users, database side.
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
-{-# LANGUAGE TemplateHaskell             #-}
-{-# LANGUAGE FlexibleContexts            #-}
-{-# LANGUAGE FlexibleInstances           #-}
-{-# LANGUAGE MultiParamTypeClasses       #-}
 {-# LANGUAGE FunctionalDependencies      #-}
 {-# LANGUAGE Arrows                      #-}
-{-# LANGUAGE NoImplicitPrelude           #-}
-{-# LANGUAGE OverloadedStrings           #-}
-{-# LANGUAGE RankNTypes                  #-}
+{-# LANGUAGE TemplateHaskell            #-}
 
 module Gargantext.Database.Schema.User where
 
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Data.Maybe (Maybe)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import GHC.Show(Show(..))
 import Gargantext.Prelude
-import Opaleye
+import GHC.Generics (Generic)
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import Data.Aeson.TH (deriveJSON)
+import Gargantext.Database.Prelude (fromField')
+import Gargantext.Core.Utils.Prefix (unPrefix)
 
-------------------------------------------------------------------------
-------------------------------------------------------------------------
+-- FIXME PLZ : the import below leads to an error, why ?
+-- import Gargantext.Database.Schema.Prelude hiding (makeLensesWith, abbreviatedFields, makeAdaptorAndInstance)
+
+-- When FIXED : Imports to remove:
+import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Opaleye hiding (FromField)
 
-data UserLight = UserLight { userLight_id   :: Int
-                           , userLight_username :: Text
-                           , userLight_email    :: Text
-                           } deriving (Show)
+------------------------------------------------------------------------
+data UserLight = UserLight { userLight_id       :: !Int
+                           , userLight_username :: !Text
+                           , userLight_email    :: !Text
+                           , userLight_password :: !Text
+                           } deriving (Show, Generic)
 
 toUserLight :: UserDB -> UserLight
-toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
+toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e p
+
 
 data UserPoly id pass llogin suser
               uname fname lname
               mail staff active djoined =
-    UserDB { user_id          :: id
-           , user_password    :: pass
-           , user_lastLogin   :: llogin
-           , user_isSuperUser :: suser
+    UserDB { user_id          :: !id
+           , user_password    :: !pass
+           , user_lastLogin   :: !llogin
+           , user_isSuperUser :: !suser
 
-           , user_username    :: uname
-           , user_firstName   :: fname
-           , user_lastName    :: lname
-           , user_email       :: mail
+           , user_username    :: !uname
+           , user_firstName   :: !fname
+           , user_lastName    :: !lname
+           , user_email       :: !mail
+
+           , user_isStaff     :: !staff
+           , user_isActive    :: !active
+           , user_dateJoined  :: !djoined
+           } deriving (Show, Generic)
 
-           , user_isStaff     :: staff
-           , user_isActive    :: active
-           , user_dateJoined  :: djoined
-           } deriving (Show)
 
 type UserWrite = UserPoly (Maybe (Column PGInt4))        (Column PGText)
                           (Maybe (Column PGTimestamptz)) (Column PGBool)
@@ -84,27 +87,32 @@ type UserReadNull = UserPoly     (Column (Nullable PGInt4))         (Column (Nul
                                  (Column (Nullable PGBool))         (Column (Nullable PGBool))
                                  (Column (Nullable PGTimestamptz))
 
-
-
-
 type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
 
 $(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
 $(makeLensesWith abbreviatedFields   ''UserPoly)
 
-
 userTable :: Table UserWrite UserRead
-userTable = Table "auth_user" (pUserDB UserDB { user_id      = optional "id"
-                                          , user_password    = required "password"
-                                          , user_lastLogin   = optional "last_login"
-                                          , user_isSuperUser = required "is_superuser"
-                                          , user_username    = required "username"
-                                          , user_firstName   = required "first_name"
-                                          , user_lastName    = required "last_name"
-                                          , user_email       = required "email"
-                                          , user_isStaff     = required "is_staff"
-                                          , user_isActive    = required "is_active"
-                                          , user_dateJoined  = optional "date_joined"
-                                          }
-                              )
-
+userTable = Table "auth_user"
+  (pUserDB UserDB { user_id      = optionalTableField "id"
+                  , user_password    = requiredTableField "password"
+                  , user_lastLogin   = optionalTableField "last_login"
+                  , user_isSuperUser = requiredTableField "is_superuser"
+                  , user_username    = requiredTableField "username"
+                  , user_firstName   = requiredTableField "first_name"
+                  , user_lastName    = requiredTableField "last_name"
+                  , user_email       = requiredTableField "email"
+                  , user_isStaff     = requiredTableField "is_staff"
+                  , user_isActive    = requiredTableField "is_active"
+                  , user_dateJoined  = optionalTableField "date_joined"
+                  }
+      )
+
+instance FromField UserLight where
+  fromField = fromField'
+
+instance FromField UserDB where
+  fromField = fromField'
+
+$(deriveJSON (unPrefix "userLight_") ''UserLight)
+$(deriveJSON (unPrefix "user_") ''UserPoly)