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