src/Data/Gargantext/Database/Ngram.hs

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