Commit 8f1a5663 authored by Alexandre Delanoë's avatar Alexandre Delanoë

First commit to start with.

parents
This diff is collapsed.
module Main where
import Hastext.Db
main :: IO ()
main = fonction
name: gargantext
version: 0.1.0.0
synopsis: Deep (Collaborative) Text mining project
description: Please see README.md
homepage: http://gargantext.org
license: BSD3
license-file: LICENSE
author: Alexandre Delanoë
maintainer: gargantext@iscpif.fr
copyright: Copyright: (c) 2016,2017 CNRS Alexandre Delanoë
category: Data
build-type: Simple
-- extra-source-files:
cabal-version: >=1.10
library
hs-source-dirs: src
build-depends: base >= 4.7 && < 5
, aeson
, attoparsec
, base16-bytestring
, bytestring
, case-insensitive
, containers
, contravariant
, directory
, extra
, filepath
, http-client
, lens
, opaleye
, postgresql-simple
, pretty
, product-profunctors
, profunctors
, protolude
, pureMD5
, regex-compat
, semigroups
, servant-multipart
, servant-server
, split
-- , stemmer
, tagsoup
, text
, time
, time-locale-compat
, transformers
--, utc
, uuid
, vector
, wai
, warp
, zlib
exposed-modules: Data.Gargantext
, Data.Gargantext.Analysis
, Data.Gargantext.DSL
, Data.Gargantext.Database
, Data.Gargantext.Database.Instances
, Data.Gargantext.Database.Ngram
, Data.Gargantext.Database.Node
, Data.Gargantext.Database.NodeNgram
, Data.Gargantext.Database.NodeNgramNgram
, Data.Gargantext.Database.NodeNode
, Data.Gargantext.Database.NodeNodeNgram
, Data.Gargantext.Database.Private
, Data.Gargantext.Database.User
, Data.Gargantext.Parsers
, Data.Gargantext.Parsers.Occurrences
, Data.Gargantext.Prelude
, Data.Gargantext.Server
, Data.Gargantext.Types
, Data.Gargantext.Types.Node
, Data.Gargantext.Types.Main
, Data.Gargantext.Utils.DateUtils
, Data.Gargantext.Utils.Prefix
default-language: Haskell2010
ghc-options: -Wall
--executable gargantext-exe
-- hs-source-dirs: app
-- main-is: Main.hs
-- ghc-options: -threaded -rtsopts -with-rtsopts=-N
-- build-depends: base
-- , hastext
-- default-language: Haskell2010
test-suite garg-test-parsers
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Parsers.hs
build-depends: base
, extra
, text
, gargantext
, hspec
, QuickCheck
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
module Data.Gargantext (
module Data.Gargantext.Database,
-- module Data.Gargantext.Ngrams,
-- module Data.Gargantext.Utils,
) where
import Data.Gargantext.Database
-- import Data.Gargantext.Ngrams
-- import Data.Gargantext.Utils
module Data.Gargantext.Analysis where
-- import qualified Data.Text.Lazy as DTL
import Data.Either.Extra (fromRight)
import Data.Gargantext.Database.Node
import Data.Gargantext.Parsers.Occurrences
import Data.Gargantext.Prelude
import Data.Gargantext.Types
import Data.Text
import Opaleye (Column, PGInt4)
-- | Simple function to count Occurrences in a context of text.
occOfDocument :: Column PGInt4 -> Text -> IO Int
occOfDocument = undefined
--occOfDocument c_id txt = do
-- docs <- pm (hyperdataDocument_Abstract . node_hyperdata) <$> getCorpusDocument c_id
-- let occs = pm (\x -> maybe "" identity x) docs
-- let result = case sequence $ pm (parseOccurrences txt) occs of
-- -- TODO find a way to get nice message d'errors (file, function, line)
-- Left str -> error $ "[ERRROR] at file/function/line" ++ str
-- Right xs -> xs
-- pure (sum result)
module Data.Gargantext.DSL where
import Data.Gargantext.Database
import Data.Gargantext.Prelude
import Data.Gargantext.Types
import Data.Text
type Username = Text
type Password = Text
--user :: Username -> Maybe User
--user username = undefined
--
--
--getNode :: Int -> IO Node
--getNode = undefined
--
--saveNode :: Node -> IO ()
--saveNode = undefined
--
--updateNode :: Node -> IO ()
--updateNode = undefined
--
--
--
--
--parents :: Node -> [Node]
--parents = undefined
--
--children :: Node -> [Node]
--children = undefined
--
--
--
-- projects :: User -> [Project]
-- projects u = undefined
module Data.Gargantext.Database ( module Data.Gargantext.Database.Private
, module Data.Gargantext.Database.Instances
, module Data.Gargantext.Database.User
, module Data.Gargantext.Database.Node
, module Data.Gargantext.Database.NodeNode
, module Data.Gargantext.Database.Ngram
, module Data.Gargantext.Database.NodeNgram
, module Data.Gargantext.Database.NodeNodeNgram
, module Data.Gargantext.Database.NodeNgramNgram
-- , module Data.Gargantext.Database.Gargandb
-- , module Data.Gargantext.Database.Simple
-- , module Data.Gargantext.Database.InsertNode
-- , module Data.Gargantext.Database.NodeType
) where
import Data.Gargantext.Database.Private
import Data.Gargantext.Database.Instances
--import Data.Gargantext.Database.Gargandb
import Data.Gargantext.Database.User
import Data.Gargantext.Database.Node
import Data.Gargantext.Database.NodeNode
import Data.Gargantext.Database.Ngram
import Data.Gargantext.Database.NodeNgram
import Data.Gargantext.Database.NodeNodeNgram
import Data.Gargantext.Database.NodeNgramNgram
--import Data.Gargantext.Database.Simple
--import Data.Gargantext.Database.NodeType
--import Data.Gargantext.Database.InsertNode
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Data.Gargantext.Database.Instances where
import Data.Time (UTCTime)
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
, QueryRunnerColumnDefault
, queryRunnerColumnDefault
, fieldQueryRunnerColumn
)
instance QueryRunnerColumnDefault PGInt4 Integer where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
module Data.Gargantext.Database.Ngram where
import Prelude
import Data.Time (UTCTime)
import Data.Text (Text)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Control.Arrow (returnA)
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz
, Table(Table), Query
, QueryRunnerColumnDefault, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, (.==), (.>)
)
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
-- Functions only
import Data.List (find)
data NgramPoly id terms n = Ngram { ngram_id :: id
, ngram_terms :: terms
, ngram_n :: n
} deriving (Show)
type NgramWrite = NgramPoly (Maybe (Column PGInt4)) (Column PGText) (Column PGInt4)
type NgramRead = NgramPoly (Column PGInt4) (Column PGText) (Column PGInt4)
type Ngram = NgramPoly Int Text Int
$(makeAdaptorAndInstance "pNgram" ''NgramPoly)
$(makeLensesWith abbreviatedFields ''NgramPoly)
ngramTable :: O.Table NgramWrite NgramRead
ngramTable = O.Table "ngrams" (pNgram Ngram { ngram_id = O.optional "id"
, ngram_terms = O.required "terms"
, ngram_n = O.required "n"
}
)
queryNgramTable :: Query NgramRead
queryNgramTable = O.queryTable ngramTable
--selectUsers :: Query UserRead
--selectUsers = proc () -> do
-- --user@(i, p, ll, is, un, fn, ln, m, iff, ive, dj) <- queryUserTable -< ()
-- row@(User i p ll is un fn ln m iff ive dj) <- queryUserTable -< ()
-- O.restrict -< i .== 1
-- --returnA -< User i p ll is un fn ln m iff ive dj
-- returnA -< row
--
findWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a
findWith f t = find (\x -> f x == t)
--userWithUsername :: Text -> [User] -> Maybe User
--userWithUsername t xs = userWith userUsername t xs
--
--userWithId :: Integer -> [User] -> Maybe User
--userWithId t xs = userWith userUserId t xs
-- | not optimized (get all ngrams without filters)
ngrams :: IO [Ngram]
ngrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNgramTable
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
module Data.Gargantext.Database.Node where
import Database.PostgreSQL.Simple.FromField (Conversion, ResultError(ConversionFailed), FromField, fromField, returnError)
import Database.PostgreSQL.Simple.Internal (Field)
import Control.Arrow (returnA)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Gargantext.Database.Instances
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Prelude
import Data.Gargantext.Types
import Data.Gargantext.Utils.Prefix
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Typeable.Internal (Typeable)
import GHC.Generics (Generic)
import qualified Data.ByteString.Internal as DBI
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
, Table(Table), PGJsonb, Query
, QueryRunnerColumnDefault, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, (.==), (.>)
)
-- | Types for Node Database Management
type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
(Column PGInt4) (Column PGInt4)
(Column PGText) (Maybe (Column PGTimestamptz))
(Column PGJsonb)
type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
(Column PGInt4) (Column PGInt4)
(Column PGText) (Column PGTimestamptz)
(Column PGJsonb)
instance FromField HyperdataCorpus where
fromField = fromField'
instance FromField HyperdataDocument where
fromField = fromField'
--instance FromField HyperdataProject where
-- fromField = fromField'
--instance FromField HyperdataUser where
-- fromField = fromField'
fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
fromField' field mb = do
v <- fromField field mb
valueToHyperdata v
where
valueToHyperdata v = case fromJSON v of
Success a -> pure a
Error err -> returnError ConversionFailed field "cannot parse hyperdata"
instance O.QueryRunnerColumnDefault PGJsonb HyperdataDocument where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance O.QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
queryRunnerColumnDefault = fieldQueryRunnerColumn
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
nodeTable :: O.Table NodeWrite NodeRead
nodeTable = O.Table "nodes" (pNode Node { node_id = O.optional "id"
, node_typename = O.required "typename"
, node_userId = O.required "user_id"
, node_parentId = O.required "parent_id"
, node_name = O.required "name"
, node_date = O.optional "date"
, node_hyperdata = O.required "hyperdata"
}
)
selectNodes :: Column PGInt4 -> Query (Column O.PGText)
selectNodes node_id = proc () -> do
row@(Node n_id tn u p n d h) <- queryNodeTable -< ()
O.restrict -< n_id .== node_id
returnA -< n
runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
runGetNodes = O.runQuery
queryNodeTable :: Query NodeRead
queryNodeTable = O.queryTable nodeTable
selectNode :: Column PGInt4 -> Query NodeRead
selectNode node_id = proc () -> do
row@(Node id tn u p_id n d h) <- queryNodeTable -< ()
O.restrict -< p_id .== node_id
returnA -< row
getNodes :: Column PGInt4 -> IO [Document]
getNodes node_id = do
conn <- PGS.connect infoGargandb
O.runQuery conn $ selectNode node_id
getCorpusDocument :: Column PGInt4 -> IO [Document]
getCorpusDocument node_id = PGS.connect infoGargandb >>=
\conn -> O.runQuery conn (selectNode node_id)
getProjectCorpora :: Column PGInt4 -> IO [Corpus]
getProjectCorpora node_id = do
conn <- PGS.connect infoGargandb
O.runQuery conn $ selectNode node_id
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
module Data.Gargantext.Database.NodeNgram where
import Prelude
import Data.Time (UTCTime)
import Data.Text (Text)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Control.Arrow (returnA)
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
, Table(Table), Query
, QueryRunnerColumnDefault, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, (.==), (.>)
)
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNgramPoly id node_id ngram_id weight
= NodeNgram { nodeNgram_NodeNgramId :: id
, nodeNgram_NodeNgramNodeId :: node_id
, nodeNgram_NodeNgramNgramId :: ngram_id
, nodeNgram_NodeNgramWeight :: weight
} deriving (Show)
type NodeNgramWrite = NodeNgramPoly (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNgramRead = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) ((Column PGFloat8))
type NodeNgram = NodeNgramPoly (Maybe Int) Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramPoly)
nodeNgramTable :: O.Table NodeNgramWrite NodeNgramRead
nodeNgramTable = O.Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId = O.optional "id"
, nodeNgram_NodeNgramNodeId = O.required "node_id"
, nodeNgram_NodeNgramNgramId = O.required "ngram_id"
, nodeNgram_NodeNgramWeight = O.optional "weight"
}
)
queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = O.queryTable nodeNgramTable
-- | not optimized (get all ngrams without filters)
nodeNgrams :: IO [NodeNgram]
nodeNgrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNgramTable
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
module Data.Gargantext.Database.NodeNgramNgram where
import Prelude
import Data.Time (UTCTime)
import Data.Text (Text)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Control.Arrow (returnA)
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
, Table(Table), Query
, QueryRunnerColumnDefault, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, (.==), (.>)
)
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNgramNgramPoly node_id ngram1_id ngram2_id weight
= NodeNgramNgram { nodeNgramNgram_NodeNgramNgram_NodeId :: node_id
, nodeNgramNgram_NodeNgramNgram_Ngram1Id :: ngram1_id
, nodeNgramNgram_NodeNgramNgram_Ngram2Id :: ngram2_id
, nodeNgramNgram_NodeNgramNgram_Weight :: weight
} deriving (Show)
type NodeNgramNgramWrite = NodeNgramNgramPoly (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNgramNgramRead = NodeNgramNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNgramNgram = NodeNgramNgramPoly (Maybe Int) Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNgramNgram" ''NodeNgramNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramNgramPoly)
nodeNgramNgramTable :: O.Table NodeNgramNgramWrite NodeNgramNgramRead
nodeNgramNgramTable = O.Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNgram
{ nodeNgramNgram_NodeNgramNgram_NodeId = O.optional "node_id"
, nodeNgramNgram_NodeNgramNgram_Ngram1Id = O.required "ngram1_id"
, nodeNgramNgram_NodeNgramNgram_Ngram2Id = O.required "ngram2_id"
, nodeNgramNgram_NodeNgramNgram_Weight = O.optional "weight"
}
)
queryNodeNgramNgramTable :: Query NodeNgramNgramRead
queryNodeNgramNgramTable = O.queryTable nodeNgramNgramTable
-- | not optimized (get all ngrams without filters)
nodeNgramNgrams :: IO [NodeNgramNgram]
nodeNgramNgrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNgramNgramTable
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
module Data.Gargantext.Database.NodeNode where
import Prelude
import Data.Time (UTCTime)
import Data.Text (Text)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Control.Arrow (returnA)
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
, Table(Table), Query
, QueryRunnerColumnDefault, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, (.==), (.>)
, required, optional
)
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNodePoly node1_id node2_id score
= NodeNode { nodeNode_node1_id :: node1_id
, nodeNode_node2_id :: node2_id
, nodeNode_score :: score
} deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNodeRead = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNode = NodeNodePoly Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
$(makeLensesWith abbreviatedFields ''NodeNodePoly)
nodeNodeTable :: O.Table NodeNodeWrite NodeNodeRead
nodeNodeTable = O.Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = optional "score"
}
)
queryNodeNodeTable :: Query NodeNodeRead
queryNodeNodeTable = O.queryTable nodeNodeTable
-- | not optimized (get all ngrams without filters)
nodeNodes :: IO [NodeNode]
nodeNodes = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNodeTable
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
module Data.Gargantext.Database.NodeNodeNgram where
import Prelude
import Data.Time (UTCTime)
import Data.Text (Text)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Control.Arrow (returnA)
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
, Table(Table), Query
, QueryRunnerColumnDefault, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, (.==), (.>)
)
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNodeNgramPoly node1_id node2_id ngram_id score
= NodeNodeNgram { nodeNodeNgram_node1_id :: node1_id
, nodeNodeNgram_node2_id :: node2_id
, nodeNodeNgram_ngram_id :: ngram_id
, nodeNodeNgram_score :: score
} deriving (Show)
type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNodeNgramRead = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)