Skip to content

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

[DB/OPTIM] schemas with bang patterns

parent 3b345bea
Hide whitespace changes
Inline Side-by-side
Showing with 82 additions and 67 deletions
src/Gargantext/Database/Schema/Ngrams.hs
View file @ 56d3a2b3
......@@ -56,9 +56,9 @@ type NgramsId = Int
type NgramsTerms = Text
type Size = Int
data NgramsPoly id terms n = NgramsDb { _ngrams_id :: id
, _ngrams_terms :: terms
, _ngrams_n :: n
data NgramsPoly id terms n = NgramsDb { _ngrams_id :: !id
, _ngrams_terms :: !terms
, _ngrams_n :: !n
} deriving (Show)
type NgramsWrite = NgramsPoly (Maybe (Column PGInt4))
......@@ -107,7 +107,7 @@ ngramsTypes = [minBound..]
instance ToSchema NgramsType
{- where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nre_")
-}
--}
instance FromJSON NgramsType
instance FromJSONKey NgramsType where
......@@ -136,7 +136,6 @@ instance ToParamSchema NgramsType where
instance QueryRunnerColumnDefault (Nullable PGInt4) NgramsTypeId
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -154,7 +153,10 @@ ngramsTypeId Sources = 3
ngramsTypeId NgramsTerms = 4
fromNgramsTypeId :: NgramsTypeId -> Maybe NgramsType
fromNgramsTypeId id = lookup id $ fromList [(ngramsTypeId nt,nt) | nt <- [minBound .. maxBound] :: [NgramsType]]
fromNgramsTypeId id = lookup id
$ fromList [ (ngramsTypeId nt,nt)
| nt <- [minBound .. maxBound] :: [NgramsType]
]
------------------------------------------------------------------------
-- | TODO put it in Gargantext.Text.Ngrams
......@@ -251,4 +253,3 @@ queryInsertNgrams = [sql|
|]
src/Gargantext/Database/Schema/Node.hs
View file @ 56d3a2b3
......@@ -44,20 +44,29 @@ import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
data NodePoly id typename userId
parentId name date
hyperdata = Node { _node_id :: id
, _node_typename :: typename
-- Main polymorphic Node definition
, _node_userId :: userId
, _node_parentId :: parentId
data NodePoly id
typename
userId
parentId
name
date
hyperdata =
Node { _node_id :: !id
, _node_typename :: !typename
, _node_name :: name
, _node_date :: date
, _node_userId :: !userId
, _node_parentId :: !parentId
, _node_hyperdata :: hyperdata
} deriving (Show, Generic)
, _node_name :: !name
, _node_date :: !date
, _node_hyperdata :: !hyperdata
} deriving (Show, Generic)
------------------------------------------------------------------------
-- Automatic instances derivation
$(deriveJSON (unPrefix "_node_") ''NodePoly)
$(makeLenses ''NodePoly)
......@@ -105,7 +114,6 @@ type NodeReadNull = NodePoly (Column (Nullable PGInt4))
(Column (Nullable PGText))
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb))
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
......@@ -144,19 +152,25 @@ type NodeSearchReadNull =
(Column (Nullable PGTSVector) )
data NodePolySearch id typename userId
parentId name date
hyperdata search = NodeSearch { _ns_id :: id
, _ns_typename :: typename
, _ns_userId :: userId
-- , nodeUniqId :: shaId
, _ns_parentId :: parentId
, _ns_name :: name
, _ns_date :: date
, _ns_hyperdata :: hyperdata
, _ns_search :: search
} deriving (Show, Generic)
data NodePolySearch id
typename
userId
parentId
name
date
hyperdata
search =
NodeSearch { _ns_id :: id
, _ns_typename :: typename
, _ns_userId :: userId
-- , nodeUniqId :: shaId
, _ns_parentId :: parentId
, _ns_name :: name
, _ns_date :: date
, _ns_hyperdata :: hyperdata
, _ns_search :: search
} deriving (Show, Generic)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
$(makeLensesWith abbreviatedFields ''NodePolySearch)
......
src/Gargantext/Database/Schema/NodeNode.hs
View file @ 56d3a2b3
......@@ -46,10 +46,10 @@ import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
import qualified Opaleye as O
data NodeNodePoly node1_id node2_id score cat
= NodeNode { _nn_node1_id :: node1_id
, _nn_node2_id :: node2_id
, _nn_score :: score
, _nn_category :: cat
= NodeNode { _nn_node1_id :: !node1_id
, _nn_node2_id :: !node2_id
, _nn_score :: !score
, _nn_category :: !cat
} deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column (PGInt4))
......
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
View file @ 56d3a2b3
......@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
......@@ -33,11 +33,11 @@ import Gargantext.Database.Admin.Types.Node
import Opaleye
data NodeNodeNgramsPoly n1 n2 ngrams_id ngt w
= NodeNodeNgrams { _nnng_node1_id :: n1
, _nnng_node2_id :: n2
, _nnng_ngrams_id :: ngrams_id
, _nnng_ngramsType :: ngt
, _nnng_weight :: w
= NodeNodeNgrams { _nnng_node1_id :: !n1
, _nnng_node2_id :: !n2
, _nnng_ngrams_id :: !ngrams_id
, _nnng_ngramsType :: !ngt
, _nnng_weight :: !w
} deriving (Show)
type NodeNodeNgramsWrite =
......
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
View file @ 56d3a2b3
......@@ -33,9 +33,9 @@ import Opaleye
import Prelude
data NodeNodeNgrams2Poly node_id nodengrams_id w
= NodeNodeNgrams2 { _nnng2_node_id :: node_id
, _nnng2_nodengrams_id :: nodengrams_id
, _nnng2_weight :: w
= NodeNodeNgrams2 { _nnng2_node_id :: !node_id
, _nnng2_nodengrams_id :: !nodengrams_id
, _nnng2_weight :: !w
} deriving (Show)
type NodeNodeNgrams2Write =
......
src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
View file @ 56d3a2b3
......@@ -46,10 +46,10 @@ import Gargantext.Prelude
import Opaleye
data Node_NodeNgrams_NodeNgrams_Poly node_id nng1_id nng2_id weight =
Node_NodeNgrams_NodeNgrams { _nnn_node_id :: node_id
, _nnn_nng1_id :: nng1_id
, _nnn_nng2_id :: nng2_id
, _nnn_weight :: weight
Node_NodeNgrams_NodeNgrams { _nnn_node_id :: !node_id
, _nnn_nng1_id :: !nng1_id
, _nnn_nng2_id :: !nng2_id
, _nnn_weight :: !weight
} deriving (Show)
type Node_NodeNgrams_NodeNgrams_Write =
......
src/Gargantext/Database/Schema/NodesNgramsRepo.hs
View file @ 56d3a2b3
......@@ -41,9 +41,9 @@ import Opaleye
data RepoDbPoly version patches
= RepoDbNgrams { _rdp_version :: version
, _rdp_patches :: patches
} deriving (Show)
= RepoDbNgrams { _rdp_version :: !version
, _rdp_patches :: !patches
} deriving (Show)
type RepoDbWrite
= RepoDbPoly (Column PGInt4)
......
src/Gargantext/Database/Schema/User.hs
View file @ 56d3a2b3
......@@ -37,9 +37,9 @@ import Opaleye
------------------------------------------------------------------------
------------------------------------------------------------------------
data UserLight = UserLight { userLight_id :: Int
, userLight_username :: Text
, userLight_email :: Text
data UserLight = UserLight { userLight_id :: !Int
, userLight_username :: !Text
, userLight_email :: !Text
} deriving (Show)
toUserLight :: UserDB -> UserLight
......@@ -48,19 +48,19 @@ toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
data UserPoly id pass llogin suser
uname fname lname
mail staff active djoined =
UserDB { 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
UserDB { 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
} deriving (Show)
type UserWrite = UserPoly (Maybe (Column PGInt4)) (Column PGText)
......
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