src/Gargantext/Database/Ngram.hs

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