[WIP] [Forgot password] render in FE
[gargantext.git] / src / Gargantext / Database / Schema / Ngrams.hs
index ac51e5149827791976337d70b3caf40caba5b47f..ff3f00213d8f9a21c20785d88137d46266b1fef4 100644 (file)
@@ -11,14 +11,16 @@ Ngrams connection to the Database.
 
 -}
 
-{-# LANGUAGE Arrows                     #-}
-{-# LANGUAGE FunctionalDependencies     #-}
+{-# OPTIONS_GHC -fno-warn-orphans   #-}
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE QuasiQuotes            #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Schema.Ngrams
   where
 
+import Data.Maybe (fromMaybe)
 import Data.HashMap.Strict (HashMap)
 import Data.Hashable (Hashable)
 import Codec.Serialise (Serialise())
@@ -30,8 +32,9 @@ import Data.Map (fromList, lookup)
 import Data.Text (Text, splitOn, pack, strip)
 import Gargantext.Core.Types (TODO(..), Typed(..))
 import Gargantext.Prelude
-import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
+import Servant (FromHttpApiData(..), Proxy(..), ToHttpApiData(..))
 import Text.Read (read)
+import Gargantext.Core (HasDBid(..))
 import Gargantext.Database.Types
 import Gargantext.Database.Schema.Prelude
 import qualified Database.PostgreSQL.Simple as PGS
@@ -46,17 +49,17 @@ data NgramsPoly id terms n = NgramsDB { _ngrams_id    :: !id
                                       , _ngrams_n     :: !n
                                       } deriving (Show)
 
-type NgramsWrite = NgramsPoly (Maybe (Column PGInt4))
-                                   (Column PGText)
-                                   (Column PGInt4)
+type NgramsWrite = NgramsPoly (Maybe (Column SqlInt4))
+                                   (Column SqlText)
+                                   (Column SqlInt4)
 
-type NgramsRead  = NgramsPoly (Column PGInt4)
-                              (Column PGText)
-                              (Column PGInt4)
+type NgramsRead  = NgramsPoly (Column SqlInt4)
+                              (Column SqlText)
+                              (Column SqlInt4)
 
-type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
-                                 (Column (Nullable PGText))
-                                 (Column (Nullable PGInt4))
+type NgramsReadNull = NgramsPoly (Column (Nullable SqlInt4))
+                                 (Column (Nullable SqlText))
+                                 (Column (Nullable SqlInt4))
 
 type NgramsDB = NgramsPoly Int Text Int
 
@@ -65,9 +68,9 @@ makeLenses ''NgramsPoly
 
 
 ngramsTable :: Table NgramsWrite NgramsRead
-ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id    = optional "id"
-                                                 , _ngrams_terms = required "terms"
-                                                 , _ngrams_n     = required "n"
+ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id    = optionalTableField "id"
+                                                 , _ngrams_terms = requiredTableField "terms"
+                                                 , _ngrams_n     = requiredTableField "n"
                                                  }
                               )
 
@@ -82,6 +85,7 @@ data NgramsType = Authors | Institutes | Sources | NgramsTerms
 
 instance Serialise NgramsType
 
+
 ngramsTypes :: [NgramsType]
 ngramsTypes = [minBound..]
 
@@ -112,20 +116,22 @@ instance ToJSONKey NgramsType where
 
 instance FromHttpApiData NgramsType where
   parseUrlPiece n = pure $ (read . cs) n
+instance ToHttpApiData NgramsType where
+  toUrlPiece = pack . show
 
 instance ToParamSchema NgramsType where
   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
 
 
-instance QueryRunnerColumnDefault (Nullable PGInt4) NgramsTypeId
+instance DefaultFromField (Nullable SqlInt4) NgramsTypeId
   where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
+    defaultFromField = fromPGSFromField
 
-pgNgramsType :: NgramsType -> Column PGInt4
+pgNgramsType :: NgramsType -> Column SqlInt4
 pgNgramsType = pgNgramsTypeId . ngramsTypeId
 
-pgNgramsTypeId :: NgramsTypeId -> Column PGInt4
-pgNgramsTypeId (NgramsTypeId n) = pgInt4 n
+pgNgramsTypeId :: NgramsTypeId -> Column SqlInt4
+pgNgramsTypeId (NgramsTypeId n) = sqlInt4 n
 
 ngramsTypeId :: NgramsType -> NgramsTypeId
 ngramsTypeId Authors     = 1
@@ -139,6 +145,16 @@ fromNgramsTypeId id = lookup id
                                | nt <- [minBound .. maxBound] :: [NgramsType]
                                ]
 
+unNgramsTypeId :: NgramsTypeId -> Int
+unNgramsTypeId (NgramsTypeId i) = i
+
+toNgramsTypeId :: Int -> NgramsTypeId
+toNgramsTypeId i = NgramsTypeId i
+
+instance HasDBid NgramsType where
+  toDBid   = unNgramsTypeId . ngramsTypeId
+  fromDBid = fromMaybe (panic "NgramsType id not indexed") . fromNgramsTypeId . toNgramsTypeId
+
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | TODO put it in Gargantext.Core.Text.Ngrams
@@ -158,6 +174,9 @@ instance FromField Ngrams where
     x <- fromField fld mdata
     pure $ text2ngrams x
 
+instance PGS.ToRow Text where
+  toRow t = [toField t]
+
 text2ngrams :: Text -> Ngrams
 text2ngrams txt = UnsafeNgrams txt' $ length $ splitOn " " txt'
   where