[WIP] [Forgot password] render in FE
[gargantext.git] / src / Gargantext / Database / Types.hs
index 87ab85368668e1a4f1e475a012a3319352e2dc7e..769a71aaa0001294d48b720509831a00981bca9f 100644 (file)
@@ -9,26 +9,56 @@ Portability : POSIX
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Types
   where
 
-import Gargantext.Prelude
+import Data.Text (Text)
+import Data.Hashable (Hashable)
+import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Schema.Prelude
+import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as PGS
 
 
 -- | Index memory of any type in Gargantext
-type Index = Int
-data Indexed a =
-  Indexed { _unIndex   :: a
-          , _index     :: Index
+data Indexed i a =
+  Indexed { _index     :: !i
+          , _unIndex   :: !a
           }
   deriving (Show, Generic, Eq, Ord)
 
 makeLenses ''Indexed
 
-instance (FromField a) => PGS.FromRow (Indexed a) where
+----------------------------------------------------------------------
+-- | Main instances
+instance (FromField i, FromField a) => PGS.FromRow (Indexed i a) where
   fromRow = Indexed <$> field <*> field
 
+instance HasText a => HasText (Indexed i a)
+  where
+    hasText (Indexed _ a) = hasText a
+
+instance (Hashable a, Hashable b) => Hashable (Indexed a b)
+
+instance DefaultFromField (Nullable SqlInt4)   Int            where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField (Nullable SqlFloat8) Int            where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField (Nullable SqlFloat8) Double         where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField SqlFloat8            (Maybe Double) where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField SqlInt4              (Maybe Int)    where
+    defaultFromField = fromPGSFromField
+
+instance DefaultFromField (Nullable SqlText)  Text  where
+    defaultFromField = fromPGSFromField
+
+