src/Gargantext/Database/Ngram.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE FunctionalDependencies #-}
   5 {-# LANGUAGE Arrows #-}
   6
   7 module Gargantext.Database.Ngram where
   8
   9 import Prelude
  10 import Data.Text (Text)
  11 import Data.Maybe (Maybe)
  12 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  13 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  14 import qualified Database.PostgreSQL.Simple as PGS
  15
  16 import Opaleye
  17
  18 import Gargantext.Database.Private (infoGargandb)
  19
  20 -- Functions only
  21 import Data.List (find)
  22
  23
  24 data NgramPoly id terms n = Ngram { ngram_id    :: id
  25                                   , ngram_terms :: terms
  26                                   , ngram_n     :: n
  27                                   } deriving (Show)
  28
  29 type NgramWrite = NgramPoly (Maybe (Column PGInt4)) (Column PGText) (Column PGInt4)
  30 type NgramRead  = NgramPoly        (Column PGInt4)  (Column PGText) (Column PGInt4)
  31
  32 type Ngram = NgramPoly Int Text Int
  33
  34 $(makeAdaptorAndInstance "pNgram"    ''NgramPoly)
  35 $(makeLensesWith abbreviatedFields   ''NgramPoly)
  36
  37
  38 ngramTable :: Table NgramWrite NgramRead
  39 ngramTable = Table "ngrams" (pNgram Ngram { ngram_id    = optional "id"
  40                                             , ngram_terms = required "terms"
  41                                             , ngram_n     = required "n"
  42                                             }
  43                                 )
  44
  45
  46 queryNgramTable :: Query NgramRead
  47 queryNgramTable = queryTable ngramTable
  48
  49
  50 --selectUsers :: Query UserRead
  51 --selectUsers = proc () -> do
  52 --      --user@(i, p, ll, is, un, fn, ln, m, iff, ive, dj) <- queryUserTable -< ()
  53 --      row@(User i p ll is un fn ln m iff ive dj) <- queryUserTable -< ()
  54 --      O.restrict -< i .== 1
  55 --      --returnA -< User i p ll is un fn ln m iff ive dj
  56 --      returnA -< row
  57 --
  58
  59 findWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a
  60 findWith f t = find (\x -> f x == t)
  61
  62 --userWithUsername :: Text -> [User] -> Maybe User
  63 --userWithUsername t xs = userWith userUsername t xs
  64 --
  65 --userWithId :: Integer -> [User] -> Maybe User
  66 --userWithId t xs = userWith userUserId t xs
  67
  68 -- | not optimized (get all ngrams without filters)
  69 ngrams :: IO [Ngram]
  70 ngrams = do
  71     conn <- PGS.connect infoGargandb
  72     runQuery conn queryNgramTable