Skip to content

haskell-gargantext
haskell-gargantext
Commit 1c3d5cfd authored by Sudhir Kumar's avatar Sudhir Kumar
Browse files
Options

removed warnings and upgraded to lts-9.2

parent 8f1a5663
Hide whitespace changes
Inline Side-by-side
Showing with 242 additions and 312 deletions
.gitignore 0 → 100644
View file @ 1c3d5cfd
.stack-work
\ No newline at end of file
gargantext.cabal
View file @ 1c3d5cfd
......@@ -15,39 +15,39 @@ cabal-version: >=1.10
library
hs-source-dirs: src
build-depends: base >= 4.7 && < 5
build-depends: base >= 4.7 && < 5
, aeson
, attoparsec
, base16-bytestring
, bytestring
, case-insensitive
, base16-bytestring
, bytestring
, case-insensitive
, containers
, contravariant
, contravariant
, directory
, extra
, filepath
, http-client
, lens
, opaleye
, postgresql-simple
, pretty
, product-profunctors
, profunctors
, postgresql-simple
, pretty
, product-profunctors
, profunctors
, protolude
, pureMD5
, regex-compat
, semigroups
, semigroups
, servant-multipart
, servant-server
, split
-- , stemmer
, tagsoup
, text
, time
, time-locale-compat
, transformers
, text
, time
, time-locale-compat
, transformers
--, utc
, uuid
, uuid
, vector
, wai
, warp
......@@ -75,7 +75,9 @@ library
, Data.Gargantext.Utils.DateUtils
, Data.Gargantext.Utils.Prefix
default-language: Haskell2010
ghc-options: -Wall
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror
-- -Werror
--executable gargantext-exe
-- hs-source-dirs: app
......
src/Data/Gargantext/Analysis.hs
View file @ 1c3d5cfd
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)
......@@ -20,4 +15,3 @@ occOfDocument = undefined
-- Left str -> error $ "[ERRROR] at file/function/line" ++ str
-- Right xs -> xs
-- pure (sum result)
src/Data/Gargantext/DSL.hs
View file @ 1c3d5cfd
module Data.Gargantext.DSL where
import Data.Gargantext.Database
import Data.Gargantext.Prelude
import Data.Gargantext.Types
import Data.Text
type Username = Text
......@@ -37,18 +34,3 @@ type Password = Text
-- projects :: User -> [Project]
-- projects u = undefined
src/Data/Gargantext/Database.hs
View file @ 1c3d5cfd
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
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
......@@ -26,4 +26,3 @@ import Data.Gargantext.Database.NodeNgramNgram
--import Data.Gargantext.Database.Simple
--import Data.Gargantext.Database.NodeType
--import Data.Gargantext.Database.InsertNode
src/Data/Gargantext/Database/Instances.hs
View file @ 1c3d5cfd
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Gargantext.Database.Instances where
import Data.Time (UTCTime)
import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
import Opaleye (PGInt4, PGTimestamptz, PGFloat8
, QueryRunnerColumnDefault
, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, queryRunnerColumnDefault
, fieldQueryRunnerColumn
)
instance QueryRunnerColumnDefault PGInt4 Integer where
......@@ -21,7 +22,3 @@ instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Data/Gargantext/Database/Ngram.hs
View file @ 1c3d5cfd
......@@ -7,24 +7,15 @@
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 Opaleye
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
-- Functions only
import Data.List (find)
......@@ -44,16 +35,16 @@ $(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"
ngramTable :: Table NgramWrite NgramRead
ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
, ngram_terms = required "terms"
, ngram_n = required "n"
}
)
queryNgramTable :: Query NgramRead
queryNgramTable = O.queryTable ngramTable
queryNgramTable = queryTable ngramTable
--selectUsers :: Query UserRead
......@@ -78,5 +69,4 @@ findWith f t = find (\x -> f x == t)
ngrams :: IO [Ngram]
ngrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNgramTable
runQuery conn queryNgramTable
src/Data/Gargantext/Database/Node.hs
View file @ 1c3d5cfd
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 Data.Typeable (Typeable)
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
, (.==), (.>)
)
import Opaleye
-- | Types for Node Database Management
......@@ -70,13 +56,13 @@ fromField' field mb = do
where
valueToHyperdata v = case fromJSON v of
Success a -> pure a
Error err -> returnError ConversionFailed field "cannot parse hyperdata"
Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
instance O.QueryRunnerColumnDefault PGJsonb HyperdataDocument where
instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance O.QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -86,55 +72,55 @@ $(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"
nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
, node_typename = required "typename"
, node_userId = required "user_id"
, node_parentId = required "parent_id"
, node_name = required "name"
, node_date = optional "date"
, node_hyperdata = required "hyperdata"
}
)
selectNodes :: Column PGInt4 -> Query (Column O.PGText)
selectNodes :: Column PGInt4 -> Query (Column PGText)
selectNodes node_id = proc () -> do
row@(Node n_id tn u p n d h) <- queryNodeTable -< ()
O.restrict -< n_id .== node_id
(Node n_id _tn _u _p n _d _h) <- queryNodeTable -< ()
restrict -< n_id .== node_id
returnA -< n
instance QueryRunnerColumnDefault PGInt4 Integer where
queryRunnerColumnDefault = fieldQueryRunnerColumn
runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
runGetNodes = O.runQuery
runGetNodes = runQuery
queryNodeTable :: Query NodeRead
queryNodeTable = O.queryTable nodeTable
queryNodeTable = 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
row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
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
runQuery conn $ selectNode node_id
getCorpusDocument :: Column PGInt4 -> IO [Document]
getCorpusDocument node_id = PGS.connect infoGargandb >>=
\conn -> O.runQuery conn (selectNode node_id)
getCorpusDocument node_id = PGS.connect infoGargandb >>=
\conn -> runQuery conn (selectNode node_id)
getProjectCorpora :: Column PGInt4 -> IO [Corpus]
getProjectCorpora node_id = do
conn <- PGS.connect infoGargandb
O.runQuery conn $ selectNode node_id
runQuery conn $ selectNode node_id
src/Data/Gargantext/Database/NodeNgram.hs
View file @ 1c3d5cfd
......@@ -3,30 +3,22 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 Opaleye
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNgramPoly id node_id ngram_id weight
data NodeNgramPoly id node_id ngram_id weight
= NodeNgram { nodeNgram_NodeNgramId :: id
, nodeNgram_NodeNgramNodeId :: node_id
, nodeNgram_NodeNgramNgramId :: ngram_id
......@@ -43,22 +35,28 @@ $(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"
}
)
nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
nodeNgramTable = Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId = optional "id"
, nodeNgram_NodeNgramNodeId = required "node_id"
, nodeNgram_NodeNgramNgramId = required "ngram_id"
, nodeNgram_NodeNgramWeight = optional "weight"
}
)
queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = O.queryTable nodeNgramTable
queryNodeNgramTable = queryTable nodeNgramTable
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
-- | not optimized (get all ngrams without filters)
nodeNgrams :: IO [NodeNgram]
nodeNgrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNgramTable
runQuery conn queryNodeNgramTable
src/Data/Gargantext/Database/NodeNgramNgram.hs
View file @ 1c3d5cfd
......@@ -3,30 +3,21 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 Opaleye
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNgramNgramPoly node_id ngram1_id ngram2_id weight
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
......@@ -44,23 +35,28 @@ $(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"
}
)
nodeNgramNgramTable :: Table NodeNgramNgramWrite NodeNgramNgramRead
nodeNgramNgramTable = Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNgram
{ nodeNgramNgram_NodeNgramNgram_NodeId = optional "node_id"
, nodeNgramNgram_NodeNgramNgram_Ngram1Id = required "ngram1_id"
, nodeNgramNgram_NodeNgramNgram_Ngram2Id = required "ngram2_id"
, nodeNgramNgram_NodeNgramNgram_Weight = optional "weight"
}
)
queryNodeNgramNgramTable :: Query NodeNgramNgramRead
queryNodeNgramNgramTable = O.queryTable nodeNgramNgramTable
queryNodeNgramNgramTable = queryTable nodeNgramNgramTable
-- | not optimized (get all ngrams without filters)
nodeNgramNgrams :: IO [NodeNgramNgram]
nodeNgramNgrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNgramNgramTable
runQuery conn queryNodeNgramNgramTable
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Data/Gargantext/Database/NodeNode.hs
View file @ 1c3d5cfd
......@@ -3,29 +3,19 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 Opaleye
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
data NodeNodePoly node1_id node2_id score
= NodeNode { nodeNode_node1_id :: node1_id
......@@ -43,8 +33,8 @@ $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
$(makeLensesWith abbreviatedFields ''NodeNodePoly)
nodeNodeTable :: O.Table NodeNodeWrite NodeNodeRead
nodeNodeTable = O.Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = optional "score"
}
......@@ -52,12 +42,14 @@ nodeNodeTable = O.Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id =
queryNodeNodeTable :: Query NodeNodeRead
queryNodeNodeTable = O.queryTable nodeNodeTable
queryNodeNodeTable = queryTable nodeNodeTable
-- | not optimized (get all ngrams without filters)
nodeNodes :: IO [NodeNode]
nodeNodes = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNodeTable
runQuery conn queryNodeNodeTable
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Data/Gargantext/Database/NodeNodeNgram.hs
View file @ 1c3d5cfd
......@@ -3,28 +3,20 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 Opaleye
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
......@@ -44,23 +36,26 @@ $(makeAdaptorAndInstance "pNodeNodeNgram" ''NodeNodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNodeNgramPoly)
nodeNodeNgramTable :: O.Table NodeNodeNgramWrite NodeNodeNgramRead
nodeNodeNgramTable = O.Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram
{ nodeNodeNgram_node1_id = O.required "node1_id"
, nodeNodeNgram_node2_id = O.required "node2_id"
, nodeNodeNgram_ngram_id = O.required "ngram_id"
, nodeNodeNgram_score = O.optional "score"
}
)
nodeNodeNgramTable :: Table NodeNodeNgramWrite NodeNodeNgramRead
nodeNodeNgramTable = Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram
{ nodeNodeNgram_node1_id = required "node1_id"
, nodeNodeNgram_node2_id = required "node2_id"
, nodeNodeNgram_ngram_id = required "ngram_id"
, nodeNodeNgram_score = optional "score"
}
)
queryNodeNodeNgramTable :: Query NodeNodeNgramRead
queryNodeNodeNgramTable = O.queryTable nodeNodeNgramTable
queryNodeNodeNgramTable = queryTable nodeNodeNgramTable
-- | not optimized (get all ngrams without filters)
nodeNodeNgrams :: IO [NodeNodeNgram]
nodeNodeNgrams = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryNodeNodeNgramTable
runQuery conn queryNodeNodeNgramTable
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Data/Gargantext/Database/User.hs
View file @ 1c3d5cfd
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Gargantext.Database.User where
......@@ -16,17 +19,8 @@ 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
, (.==), (.>)
, required, optional
)
import Opaleye
import Data.Gargantext.Database.Private (infoGargandb)
import Data.Gargantext.Database.Instances
-- Functions only
import Data.List (find)
......@@ -40,18 +34,18 @@ data UserLight = UserLight { userLight_id :: Int
toUserLight :: User -> UserLight
toUserLight (User id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
data UserPoly id pass llogin suser
uname fname lname
data UserPoly id pass llogin suser
uname fname lname
mail staff active djoined = User { user_id :: id
, user_password :: pass
, user_lastLogin :: llogin
, user_isSuperUser :: suser
, user_username :: uname
, user_firstName :: fname
, user_lastName :: lname
, user_email :: mail
, user_isStaff :: staff
, user_isActive :: active
, user_dateJoined :: djoined
......@@ -62,14 +56,14 @@ type UserWrite = UserPoly (Maybe (Column PGInt4)) (Column PGText)
(Column PGText) (Column PGText)
(Column PGText) (Column PGText)
(Column PGBool) (Column PGBool)
(Column PGTimestamptz)
(Column PGTimestamptz)
type UserRead = UserPoly (Column PGInt4) (Column PGText)
(Column PGTimestamptz) (Column PGBool)
(Column PGText) (Column PGText)
(Column PGText) (Column PGText)
(Column PGBool) (Column PGBool)
(Column PGTimestamptz)
(Column PGTimestamptz)
type User = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
......@@ -77,30 +71,30 @@ $(makeAdaptorAndInstance "pUser" ''UserPoly)
$(makeLensesWith abbreviatedFields ''UserPoly)
userTable :: O.Table UserWrite UserRead
userTable = O.Table "auth_user" (pUser User { user_id = optional "id"
, user_password = required "password"
, user_lastLogin = optional "last_login"
, user_isSuperUser = required "is_superuser"
, user_username = required "username"
, user_firstName = required "first_name"
, user_lastName = required "last_name"
, user_email = required "email"
, user_isStaff = required "is_staff"
, user_isActive = required "is_active"
, user_dateJoined = required "date_joined"
}
)
userTable :: Table UserWrite UserRead
userTable = Table "auth_user" (pUser User { user_id = optional "id"
, user_password = required "password"
, user_lastLogin = optional "last_login"
, user_isSuperUser = required "is_superuser"
, user_username = required "username"
, user_firstName = required "first_name"
, user_lastName = required "last_name"
, user_email = required "email"
, user_isStaff = required "is_staff"
, user_isActive = required "is_active"
, user_dateJoined = required "date_joined"
}
)
queryUserTable :: Query UserRead
queryUserTable = O.queryTable userTable
queryUserTable = queryTable userTable
selectUsersLight :: Query UserRead
selectUsersLight = proc () -> do
row@(User i p ll is un fn ln m iff ive dj) <- queryUserTable -< ()
O.restrict -< i .== 1
row@(User i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
restrict -< i .== 1
--returnA -< User i p ll is un fn ln m iff ive dj
returnA -< row
......@@ -114,17 +108,16 @@ userWithUsername t xs = userWith user_username t xs
userWithId :: Int -> [User] -> Maybe User
userWithId t xs = userWith user_id t xs
instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
users :: IO [User]
users = do
conn <- PGS.connect infoGargandb
O.runQuery conn queryUserTable
runQuery conn queryUserTable
usersLight :: IO [UserLight]
usersLight = do
conn <- PGS.connect infoGargandb
pm toUserLight <$> O.runQuery conn queryUserTable
pm toUserLight <$> runQuery conn queryUserTable
src/Data/Gargantext/Parsers/Occurrences.hs
View file @ 1c3d5cfd
......@@ -2,7 +2,6 @@
module Data.Gargantext.Parsers.Occurrences where
import Data.Gargantext.Prelude
import Data.Attoparsec.Text
import Data.Text (Text)
......@@ -22,7 +21,4 @@ occurrencesParser txt = case txt of
txt' = T.toLower txt
parseOccurrences :: Text -> Text -> Either String Int
parseOccurrences x = parseOnly (occurrencesParser x)
parseOccurrences x = parseOnly (occurrencesParser x)
src/Data/Gargantext/Prelude.hs
View file @ 1c3d5cfd
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Gargantext.Prelude where
import Protolude
import Protolude (Bool(True, False), Int, Double, Integer, Fractional, Num, Maybe, Floating, Char, Ord, Integral, Foldable, RealFrac, Monad, filter,
reverse
, map
, zip
, drop
, take
, zipWith
, sum
, fromIntegral
, length
, fmap
, takeWhile
, sqrt
, undefined
, identity
, abs
, maximum
, minimum
, return
, snd
, truncate
, (+), (*), (/), (-), (.), (>=), ($), (**), (^)
)
-- TODO import functions optimized in Utils.Count
-- import Protolude hiding (head, last, all, any, sum, product, length)
......@@ -13,16 +37,28 @@ import qualified Control.Monad as M
import qualified Data.Map as Map
import qualified Data.Vector as V
pf = filter
pr = reverse
pm = map
pf :: (a -> Bool) -> [a] -> [a]
pf = filter
pr :: [a] -> [a]
pr = reverse
pm :: (a -> b) -> [a] -> [b]
pm = map
pm2 :: (t -> b) -> [[t]] -> [[b]]
pm2 fun = pm (pm fun)
pz :: [a] -> [b] -> [(a, b)]
pz = zip
pd :: Int -> [a] -> [a]
pd = drop
ptk :: Int -> [a] -> [a]
ptk = take
pzw :: (a -> b -> c) -> [a] -> [b] -> [c]
pzw = zipWith
-- Exponential Average
......@@ -56,18 +92,18 @@ ma = movingAverage 3
-- | Function to split a range into chunks
chunkAlong :: Int -> Int -> [a] -> [[a]]
chunkAlong a b l = only (while dropAlong)
where
where
only = pm (take a)
while = takeWhile (\x -> length x >= a)
dropAlong = L.scanl (\x y -> drop b x) l [1..]
dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
-- | Optimized version (Vector)
chunkAlong' :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
chunkAlong' a b l = only (while dropAlong)
where
where
only = V.map (V.take a)
while = V.takeWhile (\x -> V.length x >= a)
dropAlong = V.scanl (\x y -> V.drop b x) l (V.fromList [1..])
dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
-- | TODO Inverse of chunk ? unchunkAlong ?
unchunkAlong :: Int -> Int -> [[a]] -> [a]
......@@ -82,10 +118,10 @@ splitAlong (x:xs) ys = take x ys : splitAlong xs (drop x ys) -- take until our s
takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
takeWhileM _ [] = return []
takeWhileM p (a:as) = do
takeWhileM p (a:as) = do
v <- a
if p v
then do
then do
vs <- takeWhileM p as
return (v:vs)
else return []
......@@ -110,7 +146,7 @@ sumKahan = snd . L.foldl' go (0,0)
count2map :: (Ord k, Foldable t) => t k -> Map.Map k Double
count2map xs = Map.map (/ (fromIntegral (length xs))) (count2map' xs)
-- | insert in a dict
-- | insert in a dict
count2map' :: (Ord k, Foldable t) => t k -> Map.Map k Double
count2map' xs = L.foldl' (\x y -> Map.insertWith' (+) y 1 x) Map.empty xs
......@@ -123,7 +159,7 @@ trunc' n x = fromIntegral $ truncate $ (x * 10^n)
bool2int :: Num a => Bool -> a
bool2int bool = case bool of
bool2int b = case b of
True -> 1
False -> 0
......@@ -135,6 +171,7 @@ bool2double bool = case bool of
-- Normalizing && scaling data
scale :: [Double] -> [Double]
scale = scaleMinMax
scaleMinMax :: [Double] -> [Double]
......@@ -167,4 +204,3 @@ zipFst f xs = zip (f xs) xs
zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
zipSnd f xs = zip xs (f xs)
src/Data/Gargantext/Server.hs
View file @ 1c3d5cfd
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Data.Gargantext.Server
-- ( startApp
-- , app
-- )
-- )
where
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.TH
import Data.Gargantext.Types
import Network.HTTP.Client.MultipartFormData
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
......@@ -32,11 +30,11 @@ type API = "nodes" :> Get '[JSON] [FakeNode]
:<|> "node" :> Capture "id" Int :> Get '[JSON] FakeNode
:<|> "echo" :> Capture "string" String :> Get '[JSON] String
:<|> "upload" :> MultipartForm MultipartData :> Post '[JSON] String
-- :<|> "node" :> Capture "id" Int :> Get '[JSON] Node
server :: Server API
server = pure fakeNodes
server = pure fakeNodes
:<|> fakeNode
:<|> echo
:<|> upload
......@@ -87,7 +85,3 @@ upload multipartData = do
++ " at " ++ fdFilePath file
putStrLn content
pure "Data loaded"
src/Data/Gargantext/Types/Main.hs
View file @ 1c3d5cfd
-- | CNRS Copyrights
-- | CNRS Copyrights
-- Licence: https://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE
-- Author: Alexandre Delanoë (alexandre.delanoe@iscpif.fr)
......@@ -7,7 +7,6 @@ module Data.Gargantext.Types.Main where
import Protolude (fromMaybe)
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Gargantext.Prelude
import Data.Gargantext.Types.Node ( NodePoly
, HyperdataFolder , HyperdataCorpus , HyperdataDocument
, HyperdataFavorites, HyperdataResource
......@@ -25,7 +24,7 @@ import Data.Gargantext.Types.Node ( NodePoly
data Tree a = Empty | Node' a (Tree a) (Tree a) deriving (Show)
--gargTree :: Tree NodeType
--gargTree = Node' NodeUser Empty
--gargTree = Node' NodeUser Empty
-- (Node' Empty
-- (Project Empty Empty)
-- )
......@@ -33,11 +32,11 @@ data Tree a = Empty | Node' a (Tree a) (Tree a) deriving (Show)
data NodeType = NodeUser
| Folder | Project | Corpus | Document
| Folder | Project | Corpus | Document
| Favorites
| NodeSwap
| List | StopList | MainList | MapList | GroupList
| Score | Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
| Score | Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
| Tficf | TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
deriving (Show, Eq)
......@@ -95,9 +94,9 @@ type Notebook = Node HyperdataNotebook
nodeTypes :: [(NodeType, NodeTypeId)]
nodeTypes = [
nodeTypes = [
--(NodeUser , 1)
--
--
(Project , 2)
, (NodeSwap , 19)
, (Corpus , 3)
......@@ -107,10 +106,10 @@ nodeTypes = [
, (GroupList , 6)
, (MainList , 7)
, (MapList ,  8)
-- Scores
-- Scores
, (Occurrences , 10)
, (Cooccurrences , 9)
, (Specclusion , 11)
, (Genclusion , 18)
, (Cvalue , 12)
......@@ -121,12 +120,10 @@ nodeTypes = [
, (TirankLocal , 16)
, (TirankGlobal , 17)
-- Node management
-- Node management
, (Favorites , 15)
]
--
nodeTypeId :: NodeType -> NodeTypeId
nodeTypeId tn = fromMaybe (error ("Typename " ++ show tn ++ " does not exist")) (lookup tn nodeTypes)
src/Data/Gargantext/Types/Node.hs
View file @ 1c3d5cfd
......@@ -4,13 +4,10 @@
module Data.Gargantext.Types.Node where
import Data.Text (Text)
import Data.List (lookup)
import GHC.Generics (Generic)
import Data.Time (UTCTime)
import Data.Gargantext.Utils.Prefix
import Data.Aeson.TH
import Data.Gargantext.Utils.Prefix (unPrefix)
import Data.Aeson.TH (deriveJSON)
data NodePoly id typename userId parentId name date hyperdata = Node { node_id :: id
, node_typename :: typename
......@@ -113,5 +110,3 @@ $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_Preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
src/Data/Gargantext/Utils/DateUtils.hs
View file @ 1c3d5cfd
module Data.Gargantext.Utils.DateUtils where
import Data.Time
--import Data.Dates
import Data.Time (UTCTime, toGregorian, utctDay)
--
--readInt :: IO [Char] -> IO Int
......@@ -14,7 +13,7 @@ utc2gregorian :: UTCTime -> (Integer, Int, Int)
utc2gregorian date = toGregorian $ utctDay date
gregorian2year :: (Integer, Int, Int) -> Integer
gregorian2year (y, m, d) = y
gregorian2year (y, _m, _d) = y
utc2year :: UTCTime -> Integer
utc2year date = gregorian2year $ utc2gregorian date
......@@ -29,4 +28,3 @@ averageLength l = fromIntegral (sum (map length l)) / fromIntegral (length l)
charToString :: Char -> String
charToString = (:[])
src/Data/Gargantext/Utils/Prefix.hs
View file @ 1c3d5cfd
module Data.Gargantext.Utils.Prefix where
import Control.Monad as X (mzero)
import Data.Aeson as X
import Data.Aeson.TH as X
import Data.Aeson.Types as X
import Data.Char as X (toLower)
-- import Data.Decimal as X
import Data.Maybe as X (catMaybes)
import Data.Monoid as X ((<>))
-- import Data.Scientific as X
import Data.String as X (IsString (..), fromString)
import Data.Text as X (Text, unpack, pack)
import Data.Text.Encoding as X
import Data.Aeson (Value, defaultOptions, parseJSON)
import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
import Data.Aeson.Types (Parser)
import Data.Char (toLower)
import Data.Monoid ((<>))
import Text.Read (readMaybe)
......
stack.yaml
View file @ 1c3d5cfd
flags: {}
extra-package-dbs: []
packages:
- '.'
- .
extra-deps:
- servant-0.11
- servant-multipart-0.10.0.1
- servant-server-0.11
#- utc-0.2.0.1
resolver: lts-8.21
resolver: lts-9.2
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment