Commit feb9c078 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[CLEAN] Code.

parent 2b048538
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 3346e420cce910077cbb6172c7e942960a4edd72fbab96679d4b45dacd84dcd9 -- hash: 14b119af3791906ac7f3c681c0b20b5c475078386862e0d14ce3d98919c90d85
name: gargantext name: gargantext
version: 0.1.0.0 version: 0.1.0.0
...@@ -24,7 +24,8 @@ library ...@@ -24,7 +24,8 @@ library
default-extensions: NoImplicitPrelude default-extensions: NoImplicitPrelude
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror
build-depends: build-depends:
aeson QuickCheck
, aeson
, aeson-lens , aeson-lens
, async , async
, attoparsec , attoparsec
......
...@@ -58,18 +58,19 @@ library: ...@@ -58,18 +58,19 @@ library:
- Gargantext.Utils.DateUtils - Gargantext.Utils.DateUtils
- Gargantext.Utils.Prefix - Gargantext.Utils.Prefix
dependencies: dependencies:
- base >=4.7 && <5 - QuickCheck
- aeson - aeson
- aeson-lens - aeson-lens
- attoparsec
- async - async
- attoparsec
- base >=4.7 && <5
- base16-bytestring - base16-bytestring
- bytestring - bytestring
- case-insensitive - case-insensitive
- containers
- contravariant
- conduit - conduit
- conduit-extra - conduit-extra
- containers
- contravariant
- directory - directory
- duckling - duckling
- filepath - filepath
...@@ -78,8 +79,9 @@ library: ...@@ -78,8 +79,9 @@ library:
- lens - lens
- logging-effect - logging-effect
- opaleye - opaleye
- path
- parsec - parsec
- path
- path-io
- postgresql-simple - postgresql-simple
- pretty - pretty
- product-profunctors - product-profunctors
...@@ -90,18 +92,17 @@ library: ...@@ -90,18 +92,17 @@ library:
- safe - safe
- semigroups - semigroups
- servant - servant
- servant-mock - servant-auth
- servant-client - servant-client
- servant-mock
- servant-multipart - servant-multipart
- servant-server - servant-server
- servant-auth
- split - split
- tagsoup - tagsoup
- text-metrics - text-metrics
# - utc
- time - time
- timezone-series
- time-locale-compat - time-locale-compat
- timezone-series
- transformers - transformers
- unordered-containers - unordered-containers
- uuid - uuid
...@@ -109,9 +110,9 @@ library: ...@@ -109,9 +110,9 @@ library:
- wai - wai
- warp - warp
- yaml - yaml
- zlib
- zip - zip
- path-io - zlib
# - utc
executable: executable:
main: Main.hs main: Main.hs
......
...@@ -9,7 +9,13 @@ Portability : POSIX ...@@ -9,7 +9,13 @@ Portability : POSIX
Main REST API of Gargantext (both Server and Client sides) 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 #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
...@@ -27,8 +33,10 @@ import Network.Wai ...@@ -27,8 +33,10 @@ import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Servant import Servant
import Servant.Mock (mock)
-- import Servant.API.Stream -- import Servant.API.Stream
import Data.Text (pack)
import Database.PostgreSQL.Simple (Connection, connect) import Database.PostgreSQL.Simple (Connection, connect)
import System.IO (FilePath, print) import System.IO (FilePath, print)
...@@ -41,16 +49,34 @@ import Gargantext.API.Count ( CountAPI, count, Query) ...@@ -41,16 +49,34 @@ import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.Database.Utils (databaseParameters) import Gargantext.Database.Utils (databaseParameters)
---------------------------------------------------------------------
---------------------------------------------------------------------
type PortNumber = Int
---------------------------------------------------------------------
-- | startGargantext takes as parameters port number and Ini file. -- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Int -> FilePath -> IO () startGargantext :: PortNumber -> FilePath -> IO ()
startGargantext port file = do 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 param <- databaseParameters file
conn <- connect param conn <- connect param
run port ( app conn ) 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 -- | Main routes of the API are typed
type API = "roots" :> Roots type API = "roots" :> Roots
...@@ -58,8 +84,9 @@ type API = "roots" :> Roots ...@@ -58,8 +84,9 @@ type API = "roots" :> Roots
:<|> "node" :> Capture "id" Int :> NodeAPI :<|> "node" :> Capture "id" Int :> NodeAPI
:<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI :<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI
:<|> "count" :> ReqBody '[JSON] Query :> CountAPI :<|> APIMock
-- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
type APIMock = "count" :> ReqBody '[JSON] Query :> CountAPI
-- /mv/<id>/<id> -- /mv/<id>/<id>
-- /merge/<id>/<id> -- /merge/<id>/<id>
...@@ -77,19 +104,15 @@ server conn = roots conn ...@@ -77,19 +104,15 @@ server conn = roots conn
:<|> nodesAPI conn :<|> nodesAPI conn
:<|> count :<|> 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 :: Connection -> Application
app = serve api . server app = serve api . server
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy
apiMock :: Proxy APIMock
apiMock = Proxy
...@@ -15,50 +15,123 @@ Count API part of Gargantext. ...@@ -15,50 +15,123 @@ Count API part of Gargantext.
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Gargantext.API.Count module Gargantext.API.Count
where where
import Gargantext.Prelude import Gargantext.Prelude
import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Eq (Eq())
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Servant import Servant
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Data.Aeson hiding (Error) 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 FromJSON Scraper
instance ToJSON 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] , query_name :: Maybe [Scraper]
} }
deriving (Generic) deriving (Eq, Show, Generic)
instance FromJSON Query instance FromJSON Query
instance ToJSON Query instance ToJSON Query
instance Arbitrary Query where
data Error = Error { error_message :: Text 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 , error_code :: Int
} deriving (Generic) }
deriving (Eq, Show, Generic)
instance FromJSON Error instance FromJSON Error
instance ToJSON 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 data Count = Count { count_name :: Scraper
, count_count :: Maybe Int , count_count :: Maybe Int
, count_errors :: Maybe [Error] , count_errors :: Maybe [Error]
} }
deriving (Generic) deriving (Eq, Show, Generic)
instance FromJSON Count instance FromJSON Count
instance ToJSON Count instance ToJSON Count
instance Arbitrary Count where
count :: Query -> Handler Count arbitrary = elements [ Count n (Just c) (Just [e]) | n <- scrapers
count _ = pure (Count Pubmed (Just 10) (Just [Error (pack "error message") 202])) , c <- [100..1000]
, e <- errors
]
-----------------------------------------------------------------------
count :: Query -> Handler [Count]
count _ = undefined
...@@ -121,14 +121,24 @@ leftJoin3 :: (Default NullMaker (columnsL1, nullableColumnsR) nullableColumnsR1, ...@@ -121,14 +121,24 @@ leftJoin3 :: (Default NullMaker (columnsL1, nullableColumnsR) nullableColumnsR1,
Default Unpackspec nullableColumnsR nullableColumnsR, Default Unpackspec nullableColumnsR nullableColumnsR,
Default Unpackspec columnsL1 columnsL1, Default Unpackspec columnsL1 columnsL1,
Default Unpackspec columnsL columnsL) => Default Unpackspec columnsL columnsL) =>
Query columnsL1 Query columnsL1 -> Query columnsR -> Query columnsL
-> Query columnsR
-> Query columnsL
-> ((columnsL1, columnsR) -> Column PGBool) -> ((columnsL1, columnsR) -> Column PGBool)
-> ((columnsL, (columnsL1, nullableColumnsR)) -> Column PGBool) -> ((columnsL, (columnsL1, nullableColumnsR)) -> Column PGBool)
-> Query (columnsL, nullableColumnsR1) -> Query (columnsL, nullableColumnsR1)
leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23 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 -- | Building the facet
selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
selectDocFacet' parentId _ = proc () -> do selectDocFacet' parentId _ = proc () -> do
...@@ -149,7 +159,6 @@ selectDocFacet' parentId _ = proc () -> do ...@@ -149,7 +159,6 @@ selectDocFacet' parentId _ = proc () -> do
-- Getting favorite data -- Getting favorite data
let isFav = ifThenElse (isNull docTypeId') (pgBool False) (pgBool True) let isFav = ifThenElse (isNull docTypeId') (pgBool False) (pgBool True)
-- Ngram count by document -- Ngram count by document
-- Counting the ngram -- Counting the ngram
-- (Node occId occTypeId _ _ _ _ _, NodeNode _ _ _ count) <- nodeNodeNgramLeftJoin -< () -- (Node occId occTypeId _ _ _ _ _, NodeNode _ _ _ count) <- nodeNodeNgramLeftJoin -< ()
......
...@@ -24,15 +24,19 @@ data NgramPoly id terms n = Ngram { ngram_id :: id ...@@ -24,15 +24,19 @@ data NgramPoly id terms n = Ngram { ngram_id :: id
, ngram_n :: n , ngram_n :: n
} deriving (Show) } deriving (Show)
type NgramWrite = NgramPoly (Maybe (Column PGInt4)) (Column PGText) (Column PGInt4) type NgramWrite = NgramPoly (Maybe (Column PGInt4))
type NgramRead = NgramPoly (Column PGInt4) (Column PGText) (Column PGInt4) (Column PGText)
(Column PGInt4)
type NgramRead = NgramPoly (Column PGInt4)
(Column PGText)
(Column PGInt4)
type Ngram = NgramPoly Int Text Int type Ngram = NgramPoly Int Text Int
$(makeAdaptorAndInstance "pNgram" ''NgramPoly) $(makeAdaptorAndInstance "pNgram" ''NgramPoly)
$(makeLensesWith abbreviatedFields ''NgramPoly) $(makeLensesWith abbreviatedFields ''NgramPoly)
ngramTable :: Table NgramWrite NgramRead ngramTable :: Table NgramWrite NgramRead
ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id" ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
, ngram_terms = required "terms" , ngram_terms = required "terms"
...@@ -40,7 +44,6 @@ ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id" ...@@ -40,7 +44,6 @@ ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
} }
) )
queryNgramTable :: Query NgramRead queryNgramTable :: Query NgramRead
queryNgramTable = queryTable ngramTable queryNgramTable = queryTable ngramTable
......
...@@ -118,7 +118,8 @@ runGetNodes = runQuery ...@@ -118,7 +118,8 @@ runGetNodes = runQuery
-- | order by publication date -- | order by publication date
-- Favorites (Bool), node_ngrams -- 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 = selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId --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 limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
...@@ -149,16 +150,16 @@ deleteNodes conn ns = fromIntegral ...@@ -149,16 +150,16 @@ deleteNodes conn ns = fromIntegral
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id) (\(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 = getNodesWith conn parentId nodeType maybeOffset maybeLimit =
runQuery conn $ selectNodesWith runQuery conn $ selectNodesWith
parentId nodeType maybeOffset maybeLimit parentId nodeType maybeOffset maybeLimit
-- NP check type -- 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 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
selectNodesWithParentID :: Int -> Query NodeRead selectNodesWithParentID :: Int -> Query NodeRead
...@@ -172,7 +173,6 @@ selectNodesWithParentID n = proc () -> do ...@@ -172,7 +173,6 @@ selectNodesWithParentID n = proc () -> do
returnA -< row returnA -< row
selectNodesWithType :: Column PGInt4 -> Query NodeRead selectNodesWithType :: Column PGInt4 -> Query NodeRead
selectNodesWithType type_id = proc () -> do selectNodesWithType type_id = proc () -> do
row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< () row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
......
...@@ -21,9 +21,15 @@ data NodeNgramPoly id node_id ngram_id weight ...@@ -21,9 +21,15 @@ data NodeNgramPoly id node_id ngram_id weight
, nodeNgram_NodeNgramWeight :: weight , nodeNgram_NodeNgramWeight :: weight
} deriving (Show) } deriving (Show)
type NodeNgramWrite = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8) type NodeNgramWrite = NodeNgramPoly (Column PGInt4 )
type NodeNgramRead = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8) (Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramRead = NodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgram = NodeNgramPoly Int Int Int Double type NodeNgram = NodeNgramPoly Int Int Int Double
...@@ -32,15 +38,14 @@ $(makeLensesWith abbreviatedFields ''NodeNgramPoly) ...@@ -32,15 +38,14 @@ $(makeLensesWith abbreviatedFields ''NodeNgramPoly)
nodeNgramTable :: Table NodeNgramWrite NodeNgramRead nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
nodeNgramTable = Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId = required "id" nodeNgramTable = Table "nodes_ngrams" ( pNodeNgram NodeNgram
{ nodeNgram_NodeNgramId = required "id"
, nodeNgram_NodeNgramNodeId = required "node_id" , nodeNgram_NodeNgramNodeId = required "node_id"
, nodeNgram_NodeNgramNgramId = required "ngram_id" , nodeNgram_NodeNgramNgramId = required "ngram_id"
, nodeNgram_NodeNgramWeight = required "weight" , nodeNgram_NodeNgramWeight = required "weight"
} }
) )
queryNodeNgramTable :: Query NodeNgramRead queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = queryTable nodeNgramTable queryNodeNgramTable = queryTable nodeNgramTable
...@@ -23,18 +23,28 @@ data NodeNgramNgramPoly node_id ngram1_id ngram2_id weight ...@@ -23,18 +23,28 @@ data NodeNgramNgramPoly node_id ngram1_id ngram2_id weight
} deriving (Show) } deriving (Show)
type NodeNgramNgramWrite = NodeNgramNgramPoly (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8)) type NodeNgramNgramWrite = NodeNgramNgramPoly (Maybe (Column PGInt4 ))
type NodeNgramNgramRead = NodeNgramNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8) (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) $(makeAdaptorAndInstance "pNodeNgramNgram" ''NodeNgramNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramNgramPoly) $(makeLensesWith abbreviatedFields ''NodeNgramNgramPoly)
nodeNgramNgramTable :: Table NodeNgramNgramWrite NodeNgramNgramRead nodeNgramNgramTable :: Table NodeNgramNgramWrite NodeNgramNgramRead
nodeNgramNgramTable = Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNgram nodeNgramNgramTable = Table "nodes_ngrams_ngrams"
( pNodeNgramNgram NodeNgramNgram
{ nodeNgramNgram_NodeNgramNgram_NodeId = optional "node_id" { nodeNgramNgram_NodeNgramNgram_NodeId = optional "node_id"
, nodeNgramNgram_NodeNgramNgram_Ngram1Id = required "ngram1_id" , nodeNgramNgram_NodeNgramNgram_Ngram1Id = required "ngram1_id"
, nodeNgramNgram_NodeNgramNgram_Ngram2Id = required "ngram2_id" , nodeNgramNgram_NodeNgramNgram_Ngram2Id = required "ngram2_id"
...@@ -42,11 +52,9 @@ nodeNgramNgramTable = Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNg ...@@ -42,11 +52,9 @@ nodeNgramNgramTable = Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNg
} }
) )
queryNodeNgramNgramTable :: Query NodeNgramNgramRead queryNodeNgramNgramTable :: Query NodeNgramNgramRead
queryNodeNgramNgramTable = queryTable nodeNgramNgramTable queryNodeNgramNgramTable = queryTable nodeNgramNgramTable
-- | not optimized (get all ngrams without filters) -- | not optimized (get all ngrams without filters)
nodeNgramNgrams :: PGS.Connection -> IO [NodeNgramNgram] nodeNgramNgrams :: PGS.Connection -> IO [NodeNgramNgram]
nodeNgramNgrams conn = runQuery conn queryNodeNgramNgramTable nodeNgramNgrams conn = runQuery conn queryNodeNgramNgramTable
......
...@@ -22,32 +22,31 @@ data NodeNodePoly node1_id node2_id score ...@@ -22,32 +22,31 @@ data NodeNodePoly node1_id node2_id score
, nodeNode_score :: score , nodeNode_score :: score
} deriving (Show) } deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column (Nullable PGInt4)) (Column (PGInt4)) (Column (Nullable PGFloat8)) type NodeNodeWrite = NodeNodePoly (Column (Nullable PGInt4))
type NodeNodeRead = NodeNodePoly (Column (Nullable PGInt4)) (Column (PGInt4)) (Column (Nullable PGFloat8)) (Column (PGInt4))
(Column (Nullable PGFloat8))
type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGFloat8))
-- type NodeNodeNodeJoined = (Co
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) type NodeNode = NodeNodePoly Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly) $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
$(makeLensesWith abbreviatedFields ''NodeNodePoly) $(makeLensesWith abbreviatedFields ''NodeNodePoly)
nodeNodeTable :: Table NodeNodeWrite NodeNodeRead nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id" nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode
{ nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id" , nodeNode_node2_id = required "node2_id"
, nodeNode_score = required "score" , nodeNode_score = required "score"
} }
) )
queryNodeNodeTable :: Query NodeNodeRead queryNodeNodeTable :: Query NodeNodeRead
queryNodeNodeTable = queryTable nodeNodeTable queryNodeNodeTable = queryTable nodeNodeTable
......
...@@ -25,19 +25,33 @@ data NodeNodeNgramPoly node1_id node2_id ngram_id score ...@@ -25,19 +25,33 @@ data NodeNodeNgramPoly node1_id node2_id ngram_id score
} deriving (Show) } deriving (Show)
type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8)) type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4 )
type NodeNodeNgramRead = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8) (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) $(makeAdaptorAndInstance "pNodeNodeNgram" ''NodeNodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNodeNgramPoly) $(makeLensesWith abbreviatedFields ''NodeNodeNgramPoly)
nodeNodeNgramTable :: Table NodeNodeNgramWrite NodeNodeNgramRead nodeNodeNgramTable :: Table NodeNodeNgramWrite NodeNodeNgramRead
nodeNodeNgramTable = Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram nodeNodeNgramTable = Table "nodes_nodes_ngrams"
( pNodeNodeNgram NodeNodeNgram
{ nodeNodeNgram_node1_id = required "node1_id" { nodeNodeNgram_node1_id = required "node1_id"
, nodeNodeNgram_node2_id = required "node2_id" , nodeNodeNgram_node2_id = required "node2_id"
, nodeNodeNgram_ngram_id = required "ngram_id" , nodeNodeNgram_ngram_id = required "ngram_id"
...@@ -49,11 +63,9 @@ nodeNodeNgramTable = Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram ...@@ -49,11 +63,9 @@ nodeNodeNgramTable = Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram
queryNodeNodeNgramTable :: Query NodeNodeNgramRead queryNodeNodeNgramTable :: Query NodeNodeNgramRead
queryNodeNodeNgramTable = queryTable nodeNodeNgramTable queryNodeNodeNgramTable = queryTable nodeNodeNgramTable
-- | not optimized (get all ngrams without filters) -- | not optimized (get all ngrams without filters)
nodeNodeNgrams :: PGS.Connection -> IO [NodeNodeNgram] nodeNodeNgrams :: PGS.Connection -> IO [NodeNodeNgram]
nodeNodeNgrams conn = runQuery conn queryNodeNodeNgramTable nodeNodeNgrams conn = runQuery conn queryNodeNodeNgramTable
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn queryRunnerColumnDefault = fieldQueryRunnerColumn
...@@ -28,16 +28,23 @@ import Opaleye ...@@ -28,16 +28,23 @@ import Opaleye
-- (Query, limit, offset) -- (Query, limit, offset)
type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4) type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4) (Column (Nullable PGInt4)) (Column PGInt4 )
(Column (PGText)) (Maybe (Column PGTimestamptz)) (Column PGInt4 )
(Column PGJsonb) -- (Maybe (Column PGTSVector)) (Column (Nullable PGInt4 ))
(Column (PGText ))
type NodeRead = NodePoly (Column PGInt4) (Column PGInt4) (Maybe (Column PGTimestamptz))
(Column PGInt4) (Column (Nullable PGInt4)) (Column PGJsonb )
(Column (PGText)) (Column PGTimestamptz) -- (Maybe (Column PGTSVector))
(Column PGJsonb) -- (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 join3 :: Query columnsA -> Query columnsB -> Query columnsC
-> ((columnsA, columnsB, columnsC) -> Column PGBool) -> ((columnsA, columnsB, columnsC) -> Column PGBool)
...@@ -51,14 +58,11 @@ join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond ...@@ -51,14 +58,11 @@ join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
-- -> Query (columnsL, nullableColumnsR) -- -> Query (columnsL, nullableColumnsR)
--leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23 --leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
limit' :: Maybe Limit -> Query a -> Query a limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
...@@ -38,15 +38,14 @@ databaseParameters fp = do ...@@ -38,15 +38,14 @@ databaseParameters fp = do
, PGS.connectPort = read (val "DB_PORT") :: Word16 , PGS.connectPort = read (val "DB_PORT") :: Word16
, PGS.connectUser = val "DB_USER" , PGS.connectUser = val "DB_USER"
, PGS.connectPassword = val "DB_PASS" , PGS.connectPassword = val "DB_PASS"
, PGS.connectDatabase = val "DB_NAME" } , PGS.connectDatabase = val "DB_NAME"
}
connectGargandb :: FilePath -> IO Connection connectGargandb :: FilePath -> IO Connection
connectGargandb fp = do connectGargandb fp = do
parameters <- databaseParameters fp parameters <- databaseParameters fp
connect parameters connect parameters
printSql :: Default Unpackspec a a => Query a -> IO () printSql :: Default Unpackspec a a => Query a -> IO ()
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres 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