-}
-{-# 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())
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
, _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
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"
}
)
instance Serialise NgramsType
+
ngramsTypes :: [NgramsType]
ngramsTypes = [minBound..]
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
| 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
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