-}
-{-# 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.HashMap.Strict (HashMap)
-import Data.Hashable (Hashable)
import Codec.Serialise (Serialise())
import Control.Lens (over)
import Control.Monad (mzero)
import Data.Aeson
import Data.Aeson.Types (toJSONKeyText)
+import Data.HashMap.Strict (HashMap)
+import Data.Hashable (Hashable)
import Data.Map (fromList, lookup)
+import Data.Maybe (fromMaybe)
import Data.Text (Text, splitOn, pack, strip)
+import Database.PostgreSQL.Simple.FromField (returnError, ResultError(..))
+import Gargantext.Core (HasDBid(..))
import Gargantext.Core.Types (TODO(..), Typed(..))
+import Gargantext.Database.Schema.Prelude
+import Gargantext.Database.Types
import Gargantext.Prelude
import Servant (FromHttpApiData(..), Proxy(..), ToHttpApiData(..))
+import Test.QuickCheck (elements)
import Text.Read (read)
-import Gargantext.Database.Types
-import Gargantext.Database.Schema.Prelude
-import qualified Database.PostgreSQL.Simple as PGS
+import qualified Data.ByteString.Char8 as B
import qualified Data.HashMap.Strict as HashMap
+import qualified Database.PostgreSQL.Simple as PGS
type NgramsId = Int
, _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
deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
instance Serialise NgramsType
+instance FromJSON NgramsType
+ where
+ parseJSON (String "Authors") = pure Authors
+ parseJSON (String "Institutes") = pure Institutes
+ parseJSON (String "Sources") = pure Sources
+ parseJSON (String "Terms") = pure NgramsTerms
+ parseJSON (String "NgramsTerms") = pure NgramsTerms
+ parseJSON _ = mzero
+
+instance FromJSONKey NgramsType where
+ fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
+
+instance ToJSON NgramsType
+ where
+ toJSON Authors = String "Authors"
+ toJSON Institutes = String "Institutes"
+ toJSON Sources = String "Sources"
+ toJSON NgramsTerms = String "Terms"
+
+instance ToJSONKey NgramsType where
+ toJSONKey = toJSONKeyText (pack . show)
+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 Arbitrary NgramsType where
+ arbitrary = elements [ minBound .. maxBound ]
+
+-- map NgramsType to its assigned id
+instance FromField NgramsType where
+ fromField fld mdata =
+ case B.unpack `fmap` mdata of
+ Nothing -> returnError UnexpectedNull fld ""
+ Just dat -> do
+ n <- fromField fld mdata
+ if (n :: Int) > 0 then
+ case fromNgramsTypeId (NgramsTypeId n) of
+ Nothing -> returnError ConversionFailed fld dat
+ Just nt -> pure nt
+ else
+ returnError ConversionFailed fld dat
+instance ToField NgramsType where
+ toField nt = toField $ ngramsTypeId nt
+
ngramsTypes :: [NgramsType]
ngramsTypes = [minBound..]
newtype NgramsTypeId = NgramsTypeId Int
deriving (Eq, Show, Ord, Num)
-
instance ToField NgramsTypeId where
toField (NgramsTypeId n) = toField n
-
instance FromField NgramsTypeId where
fromField fld mdata = do
n <- fromField fld mdata
if (n :: Int) > 0 then return $ NgramsTypeId n
else mzero
-
-instance FromJSON NgramsType
-instance FromJSONKey NgramsType where
- fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
-
-instance ToJSON NgramsType
-instance ToJSONKey NgramsType where
- toJSONKey = toJSONKeyText (pack . show)
-
-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 DefaultFromField (Nullable PGInt4) NgramsTypeId
+instance DefaultFromField (Nullable SqlInt4) NgramsTypeId
where
- defaultFromField = fieldQueryRunnerColumn
+ defaultFromField = fromPGSFromField
-pgNgramsType :: NgramsType -> Column PGInt4
+pgNgramsType :: NgramsType -> Column SqlInt4
pgNgramsType = pgNgramsTypeId . ngramsTypeId
-pgNgramsTypeId :: NgramsTypeId -> Column PGInt4
+pgNgramsTypeId :: NgramsTypeId -> Column SqlInt4
pgNgramsTypeId (NgramsTypeId n) = sqlInt4 n
ngramsTypeId :: NgramsType -> NgramsTypeId
| 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