Skip to content

haskell-gargantext
haskell-gargantext
Commit feb9c078 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[CLEAN] Code.

parent 2b048538
Hide whitespace changes
Inline Side-by-side
Showing with 274 additions and 137 deletions
gargantext.cabal
View file @ feb9c078
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 3346e420cce910077cbb6172c7e942960a4edd72fbab96679d4b45dacd84dcd9
-- hash: 14b119af3791906ac7f3c681c0b20b5c475078386862e0d14ce3d98919c90d85
name: gargantext
version: 0.1.0.0
......@@ -24,7 +24,8 @@ library
default-extensions: NoImplicitPrelude
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror
build-depends:
aeson
QuickCheck
, aeson
, aeson-lens
, async
, attoparsec
......
package.yaml
View file @ feb9c078
......@@ -58,18 +58,19 @@ library:
- Gargantext.Utils.DateUtils
- Gargantext.Utils.Prefix
dependencies:
- base >=4.7 && <5
- QuickCheck
- aeson
- aeson-lens
- attoparsec
- async
- attoparsec
- base >=4.7 && <5
- base16-bytestring
- bytestring
- case-insensitive
- containers
- contravariant
- conduit
- conduit-extra
- containers
- contravariant
- directory
- duckling
- filepath
......@@ -78,8 +79,9 @@ library:
- lens
- logging-effect
- opaleye
- path
- parsec
- path
- path-io
- postgresql-simple
- pretty
- product-profunctors
......@@ -90,18 +92,17 @@ library:
- safe
- semigroups
- servant
- servant-mock
- servant-auth
- servant-client
- servant-mock
- servant-multipart
- servant-server
- servant-auth
- split
- tagsoup
- text-metrics
# - utc
- time
- timezone-series
- time-locale-compat
- timezone-series
- transformers
- unordered-containers
- uuid
......@@ -109,9 +110,9 @@ library:
- wai
- warp
- yaml
- zlib
- zip
- path-io
- zlib
# - utc
executable:
main: Main.hs
......
src/Gargantext/API.hs
View file @ feb9c078
......@@ -9,7 +9,13 @@ Portability : POSIX
Main REST API of Gargantext (both Server and Client sides)
TODO/IDEA, use MOCK feature of Servant to generate fake data (for tests)
TODO App type, the main monad in which the bot code is written with.
Provide config, state, logs and IO
type App m a = ( MonadState AppState m
, MonadReader Conf m
, MonadLog (WithSeverity Doc) m
, MonadIO m) => m a
Thanks @yannEsposito for this.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
......@@ -27,8 +33,10 @@ import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Servant.Mock (mock)
-- import Servant.API.Stream
import Data.Text (pack)
import Database.PostgreSQL.Simple (Connection, connect)
import System.IO (FilePath, print)
......@@ -41,16 +49,34 @@ import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.Database.Utils (databaseParameters)
---------------------------------------------------------------------
---------------------------------------------------------------------
type PortNumber = Int
---------------------------------------------------------------------
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Int -> FilePath -> IO ()
startGargantext :: PortNumber -> FilePath -> IO ()
startGargantext port file = do
print ("Starting server on port " <> show port)
print ("Starting Gargantext server" <> show port)
print ("http://localhost:" <> show port)
param <- databaseParameters file
conn <- connect param
run port ( app conn )
startGargantextMock :: PortNumber -> IO ()
startGargantextMock port = do
print (pack "Starting Mock server")
print (pack $ "curl "
<> "-H \"content-type: application/json"
<> "-d \'{\"query_query\":\"query\"}\' "
<> "-v http://localhost:"
<> show port
<>"/count"
)
run port ( serve apiMock $ mock apiMock Proxy )
---------------------------------------------------------------------
---------------------------------------------------------------------
-- | Main routes of the API are typed
type API = "roots" :> Roots
......@@ -58,8 +84,9 @@ type API = "roots" :> Roots
:<|> "node" :> Capture "id" Int :> NodeAPI
:<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI
:<|> "count" :> ReqBody '[JSON] Query :> CountAPI
:<|> APIMock
-- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
type APIMock = "count" :> ReqBody '[JSON] Query :> CountAPI
-- /mv/<id>/<id>
-- /merge/<id>/<id>
......@@ -72,24 +99,20 @@ type API = "roots" :> Roots
-- | Server declaration
server :: Connection -> Server API
server conn = roots conn
:<|> nodeAPI conn
server conn = roots conn
:<|> nodeAPI conn
:<|> nodesAPI conn
:<|> count
-- | TODO App type, the main monad in which the bot code is written with.
-- Provide config, state, logs and IO
-- type App m a = ( MonadState AppState m
-- , MonadReader Conf m
-- , MonadLog (WithSeverity Doc) m
-- , MonadIO m) => m a
-- Thanks @yannEsposito for this.
---------------------------------------------------------------------
---------------------------------------------------------------------
app :: Connection -> Application
app = serve api . server
api :: Proxy API
api = Proxy
apiMock :: Proxy APIMock
apiMock = Proxy
src/Gargantext/API/Count.hs
View file @ feb9c078
......@@ -15,50 +15,123 @@ Count API part of Gargantext.
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Gargantext.API.Count
where
import Gargantext.Prelude
import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Eq (Eq())
import Data.Text (Text, pack)
import Servant
import GHC.Generics (Generic)
import Data.Aeson hiding (Error)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements)
import Data.List (repeat,permutations)
-----------------------------------------------------------------------
type CountAPI = Post '[JSON] [Count]
-----------------------------------------------------------------------
data Scraper = Pubmed | Hal | IsTex | Isidore
deriving (Eq, Show, Generic, Enum, Bounded)
scrapers :: [Scraper]
scrapers = [minBound..maxBound]
type CountAPI = Post '[JSON] Count
data Scraper = Pubmed | Hal
deriving (Generic)
instance FromJSON Scraper
instance ToJSON Scraper
instance Arbitrary Scraper where
arbitrary = elements scrapers
-----------------------------------------------------------------------
-----------------------------------------------------------------------
data QueryBool = QueryBool Text
deriving (Eq, Show, Generic)
queries :: [QueryBool]
queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
instance Arbitrary QueryBool where
arbitrary = elements queries
instance FromJSON QueryBool
instance ToJSON QueryBool
data Query = Query { query_query :: Text
data Query = Query { query_query :: QueryBool
, query_name :: Maybe [Scraper]
}
deriving (Generic)
deriving (Eq, Show, Generic)
instance FromJSON Query
instance ToJSON Query
data Error = Error { error_message :: Text
instance Arbitrary Query where
arbitrary = elements [ Query q (Just n)
| q <- queries
, n <- take 10 $ permutations scrapers
]
-----------------------------------------------------------------------
-----------------------------------------------------------------------
data ErrorMessage = ErrorMessage Text
deriving (Eq, Show, Generic)
errorMessages :: [ErrorMessage]
errorMessages = map (\m -> ErrorMessage (pack m)) $ [ "Ill formed query "
, "API connexion error "
, "Internal Gargantext Error "
, "Connexion to Gargantext Error"
-- , "Token has expired "
] <> take 100 ( repeat ("No Error"))
instance Arbitrary ErrorMessage where
arbitrary = elements errorMessages
instance FromJSON ErrorMessage
instance ToJSON ErrorMessage
-----------------------------------------------------------------------
data Error = Error { error_message :: ErrorMessage
, error_code :: Int
} deriving (Generic)
}
deriving (Eq, Show, Generic)
instance FromJSON Error
instance ToJSON Error
errorCodes :: [Int]
errorCodes = [200,300,400,500]
errors :: [Error]
errors = [ Error m c | m <- errorMessages
, c <- errorCodes
]
instance Arbitrary Error where
arbitrary = elements errors
-----------------------------------------------------------------------
-----------------------------------------------------------------------
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
, count_errors :: Maybe [Error]
}
deriving (Generic)
}
deriving (Eq, Show, Generic)
instance FromJSON Count
instance ToJSON Count
count :: Query -> Handler Count
count _ = pure (Count Pubmed (Just 10) (Just [Error (pack "error message") 202]))
instance Arbitrary Count where
arbitrary = elements [ Count n (Just c) (Just [e]) | n <- scrapers
, c <- [100..1000]
, e <- errors
]
-----------------------------------------------------------------------
count :: Query -> Handler [Count]
count _ = undefined
src/Gargantext/Database/Facet.hs
View file @ feb9c078
......@@ -116,19 +116,29 @@ nodeNodeNgramLeftJoin' nId = leftJoin queryNodeTable queryNodeNodeNgramTable (eq
leftJoin3 :: (Default NullMaker (columnsL1, nullableColumnsR) nullableColumnsR1,
Default NullMaker columnsR nullableColumnsR,
Default Unpackspec columnsR columnsR,
Default Unpackspec nullableColumnsR nullableColumnsR,
Default Unpackspec columnsL1 columnsL1,
Default Unpackspec columnsL columnsL) =>
Query columnsL1
-> Query columnsR
-> Query columnsL
-> ((columnsL1, columnsR) -> Column PGBool)
-> ((columnsL, (columnsL1, nullableColumnsR)) -> Column PGBool)
-> Query (columnsL, nullableColumnsR1)
Default NullMaker columnsR nullableColumnsR,
Default Unpackspec columnsR columnsR,
Default Unpackspec nullableColumnsR nullableColumnsR,
Default Unpackspec columnsL1 columnsL1,
Default Unpackspec columnsL columnsL) =>
Query columnsL1 -> Query columnsR -> Query columnsL
-> ((columnsL1, columnsR) -> Column PGBool)
-> ((columnsL, (columnsL1, nullableColumnsR)) -> Column PGBool)
-> Query (columnsL, nullableColumnsR1)
leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
--leftJoin3' :: Query (NodeRead, NodeNodeNgramReadNull)
--leftJoin3' = leftJoin3 queryNodeTable queryNodeNodeNgramTable queryNodeTable cond12 cond23
-- where
-- cond12 (Node _ _ _ _ _ _ _, NodeNodeNgram _ _ _ _)
-- = pgBool True
--
-- cond23 (Node _ _ _ _ _ _ _, (Node _ _ _ _ _ _ _, NodeNodeNgram _ _ _ _))
-- = pgBool True
-- | Building the facet
selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
selectDocFacet' parentId _ = proc () -> do
......@@ -149,7 +159,6 @@ selectDocFacet' parentId _ = proc () -> do
-- Getting favorite data
let isFav = ifThenElse (isNull docTypeId') (pgBool False) (pgBool True)
-- Ngram count by document
-- Counting the ngram
-- (Node occId occTypeId _ _ _ _ _, NodeNode _ _ _ count) <- nodeNodeNgramLeftJoin -< ()
......
src/Gargantext/Database/Ngram.hs
View file @ feb9c078
......@@ -24,15 +24,19 @@ data NgramPoly id terms n = Ngram { ngram_id :: id
, 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 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 :: Table NgramWrite NgramRead
ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
, ngram_terms = required "terms"
......@@ -40,7 +44,6 @@ ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
}
)
queryNgramTable :: Query NgramRead
queryNgramTable = queryTable ngramTable
......
src/Gargantext/Database/Node.hs
View file @ feb9c078
......@@ -118,7 +118,8 @@ runGetNodes = runQuery
-- | order by publication date
-- Favorites (Bool), node_ngrams
selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
selectNodesWith :: ParentId -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> Query NodeRead
selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
......@@ -149,16 +150,16 @@ deleteNodes conn ns = fromIntegral
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
getNodesWith :: Connection -> Int -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> IO [Node Value]
getNodesWith conn parentId nodeType maybeOffset maybeLimit =
runQuery conn $ selectNodesWith
parentId nodeType maybeOffset maybeLimit
-- NP check type
getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
getNodesWithParentId :: Connection -> Int
-> Maybe Text -> IO [Node Value]
getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
selectNodesWithParentID :: Int -> Query NodeRead
......@@ -172,7 +173,6 @@ selectNodesWithParentID n = proc () -> do
returnA -< row
selectNodesWithType :: Column PGInt4 -> Query NodeRead
selectNodesWithType type_id = proc () -> do
row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
......
src/Gargantext/Database/NodeNgram.hs
View file @ feb9c078
......@@ -21,9 +21,15 @@ data NodeNgramPoly id node_id ngram_id weight
, nodeNgram_NodeNgramWeight :: weight
} deriving (Show)
type NodeNgramWrite = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNgramRead = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNgramWrite = NodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramRead = NodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgram = NodeNgramPoly Int Int Int Double
......@@ -32,15 +38,14 @@ $(makeLensesWith abbreviatedFields ''NodeNgramPoly)
nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
nodeNgramTable = Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId = required "id"
, nodeNgram_NodeNgramNodeId = required "node_id"
, nodeNgram_NodeNgramNgramId = required "ngram_id"
, nodeNgram_NodeNgramWeight = required "weight"
}
nodeNgramTable = Table "nodes_ngrams" ( pNodeNgram NodeNgram
{ nodeNgram_NodeNgramId = required "id"
, nodeNgram_NodeNgramNodeId = required "node_id"
, nodeNgram_NodeNgramNgramId = required "ngram_id"
, nodeNgram_NodeNgramWeight = required "weight"
}
)
queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = queryTable nodeNgramTable
src/Gargantext/Database/NodeNgramNgram.hs
View file @ feb9c078
......@@ -23,30 +23,38 @@ data NodeNgramNgramPoly node_id ngram1_id ngram2_id 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 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)
type NodeNgramNgram = NodeNgramNgramPoly (Maybe Int )
Int
Int
(Maybe Double)
$(makeAdaptorAndInstance "pNodeNgramNgram" ''NodeNgramNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramNgramPoly)
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"
}
)
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 = queryTable nodeNgramNgramTable
-- | not optimized (get all ngrams without filters)
nodeNgramNgrams :: PGS.Connection -> IO [NodeNgramNgram]
nodeNgramNgrams conn = runQuery conn queryNodeNgramNgramTable
......
src/Gargantext/Database/NodeNode.hs
View file @ feb9c078
......@@ -22,31 +22,30 @@ data NodeNodePoly node1_id node2_id score
, nodeNode_score :: score
} deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column (Nullable PGInt4)) (Column (PGInt4)) (Column (Nullable PGFloat8))
type NodeNodeRead = NodeNodePoly (Column (Nullable PGInt4)) (Column (PGInt4)) (Column (Nullable PGFloat8))
type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGFloat8))
-- type NodeNodeNodeJoined = (Co
type NodeNodeWrite = NodeNodePoly (Column (Nullable PGInt4))
(Column (PGInt4))
(Column (Nullable PGFloat8))
type NodeNodeRead = NodeNodePoly (Column (Nullable PGInt4))
(Column (PGInt4))
(Column (Nullable PGFloat8))
type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGFloat8))
type NodeNode = NodeNodePoly Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
$(makeLensesWith abbreviatedFields ''NodeNodePoly)
nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = required "score"
}
)
nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode
{ nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = required "score"
}
)
queryNodeNodeTable :: Query NodeNodeRead
queryNodeNodeTable = queryTable nodeNodeTable
......
src/Gargantext/Database/NodeNodeNgram.hs
View file @ feb9c078
......@@ -25,35 +25,47 @@ data NodeNodeNgramPoly node1_id node2_id ngram_id 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)
type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGFloat8))
type NodeNodeNgramReadNull = NodeNodeNgramPoly (Column(Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGFloat8))
type NodeNodeNgramRead = NodeNodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgramReadNull = NodeNodeNgramPoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNodeNgram = NodeNodeNgramPoly Int
Int
Int
(Maybe Double)
type NodeNodeNgram = NodeNodeNgramPoly Int Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNodeNgram" ''NodeNodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNodeNgramPoly)
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"
}
)
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 = queryTable nodeNodeNgramTable
-- | not optimized (get all ngrams without filters)
nodeNodeNgrams :: PGS.Connection -> IO [NodeNodeNgram]
nodeNodeNgrams conn = runQuery conn queryNodeNodeNgramTable
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Gargantext/Database/Queries.hs
View file @ feb9c078
......@@ -28,16 +28,23 @@ import Opaleye
-- (Query, limit, offset)
type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
(Column PGInt4) (Column (Nullable PGInt4))
(Column (PGText)) (Maybe (Column PGTimestamptz))
(Column PGJsonb) -- (Maybe (Column PGTSVector))
type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
(Column PGInt4) (Column (Nullable PGInt4))
(Column (PGText)) (Column PGTimestamptz)
(Column PGJsonb) -- (Column PGTSVector)
type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
-- (Maybe (Column PGTSVector))
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGTimestamptz )
(Column PGJsonb)
-- (Column PGTSVector)
join3 :: Query columnsA -> Query columnsB -> Query columnsC
-> ((columnsA, columnsB, columnsC) -> Column PGBool)
......@@ -51,14 +58,11 @@ join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
-- -> Query (columnsL, nullableColumnsR)
--leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
src/Gargantext/Database/Utils.hs
View file @ feb9c078
......@@ -34,19 +34,18 @@ databaseParameters fp = do
Left _ -> panic (pack $ "no" <> x)
Right p' -> unpack p'
pure $ PGS.ConnectInfo { PGS.connectHost = val "DB_HOST"
, PGS.connectPort = read (val "DB_PORT") :: Word16
, PGS.connectUser = val "DB_USER"
, PGS.connectPassword = val "DB_PASS"
, PGS.connectDatabase = val "DB_NAME" }
pure $ PGS.ConnectInfo { PGS.connectHost = val "DB_HOST"
, PGS.connectPort = read (val "DB_PORT") :: Word16
, PGS.connectUser = val "DB_USER"
, PGS.connectPassword = val "DB_PASS"
, PGS.connectDatabase = val "DB_NAME"
}
connectGargandb :: FilePath -> IO Connection
connectGargandb fp = do
parameters <- databaseParameters fp
connect parameters
printSql :: Default Unpackspec a a => Query a -> IO ()
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres
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