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 -- Functions only
  19 import Data.List (find)
  20
  21
  22 data NgramPoly id terms n = Ngram { ngram_id    :: id
  23                                   , ngram_terms :: terms
  24                                   , ngram_n     :: n
  25                                   } deriving (Show)
  26
  27 type NgramWrite = NgramPoly (Maybe (Column PGInt4))
  28                                    (Column PGText)
  29                                    (Column PGInt4)
  30
  31 type NgramRead  = NgramPoly        (Column PGInt4)
  32                                    (Column PGText)
  33                                    (Column PGInt4)
  34
  35 type Ngram = NgramPoly Int Text Int
  36
  37 $(makeAdaptorAndInstance "pNgram"    ''NgramPoly)
  38 $(makeLensesWith abbreviatedFields   ''NgramPoly)
  39
  40 ngramTable :: Table NgramWrite NgramRead
  41 ngramTable = Table "ngrams" (pNgram Ngram { ngram_id    = optional "id"
  42                                             , ngram_terms = required "terms"
  43                                             , ngram_n     = required "n"
  44                                             }
  45                                 )
  46
  47 queryNgramTable :: Query NgramRead
  48 queryNgramTable = queryTable ngramTable
  49
  50
  51 --selectUsers :: Query UserRead
  52 --selectUsers = proc () -> do
  53 --      --user@(i, p, ll, is, un, fn, ln, m, iff, ive, dj) <- queryUserTable -< ()
  54 --      row@(User i p ll is un fn ln m iff ive dj) <- queryUserTable -< ()
  55 --      O.restrict -< i .== 1
  56 --      --returnA -< User i p ll is un fn ln m iff ive dj
  57 --      returnA -< row
  58 --
  59
  60 findWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a
  61 findWith f t = find (\x -> f x == t)
  62
  63 --userWithUsername :: Text -> [User] -> Maybe User
  64 --userWithUsername t xs = userWith userUsername t xs
  65 --
  66 --userWithId :: Integer -> [User] -> Maybe User
  67 --userWithId t xs = userWith userUserId t xs
  68
  69 -- | not optimized (get all ngrams without filters)
  70 getNgrams :: PGS.Connection -> IO [Ngram]
  71 getNgrams conn = runQuery conn queryNgramTable