Skip to content

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

[CLEAN] Prelude.Utils clock measures

parent 4a25b912
Hide whitespace changes
Inline Side-by-side
Showing with 61 additions and 74 deletions
src/Gargantext/API/Ngrams.hs
View file @ e55c38aa
......@@ -88,56 +88,51 @@ import Control.Concurrent
import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex)
import Control.Monad.Reader
import Data.Aeson hiding ((.=))
import qualified Data.Aeson.Text as DAT
import Data.Either (Either(..))
import Data.Foldable
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.Patch as PM
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Ord (Down(..))
import Data.Patch.Class (Action(act), Transformable(..), ours)
import qualified Data.Set as S
import qualified Data.Set as Set
import Data.Swagger hiding (version, patch)
import Data.Text (Text, isInfixOf, unpack)
import Data.Text.Lazy.IO as DTL
import Formatting (hprint, int, (%))
import Formatting.Clock (timeSpecs)
import GHC.Generics (Generic)
import Servant hiding (Patch)
import System.Clock (getTime, TimeSpec, Clock(..))
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import System.IO (stderr)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Prelude (error)
import Gargantext.Prelude hiding (log)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings)
import qualified Gargantext.API.Metrics as Metrics
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude
import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid)
import Gargantext.Core.Utils (something)
-- import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-- import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional))
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Node (NodeType(..))
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select
import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngramsType, ngrams_terms)
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select
import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId)
import Gargantext.Prelude hiding (log)
import Gargantext.Prelude.Job
import Gargantext.Prelude.Utils (hasTime, getTime)
import Prelude (error)
import Servant hiding (Patch)
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import System.IO (stderr)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Data.Aeson.Text as DAT
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.Patch as PM
import qualified Data.Set as S
import qualified Data.Set as Set
import qualified Gargantext.API.Metrics as Metrics
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
{-
-- TODO sequences of modifications (Patchs)
......@@ -476,9 +471,6 @@ type MaxSize = Int
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- TODO: should take only one ListId
getTime' :: MonadBase IO m => m TimeSpec
getTime' = liftBase $ getTime ProcessCPUTime
getTableNgrams :: forall env err m.
(RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
......@@ -492,7 +484,7 @@ getTableNgrams :: forall env err m.
getTableNgrams _nType nId tabType listId limit_ offset
listType minSize maxSize orderBy searchQuery = do
t0 <- getTime'
t0 <- getTime
-- lIds <- selectNodesWithUsername NodeList userMaster
let
ngramsType = ngramsTypeFromTabType tabType
......@@ -546,14 +538,14 @@ getTableNgrams _nType nId tabType listId limit_ offset
setScores False table = pure table
setScores True table = do
let ngrams_terms = table ^.. each . ne_ngrams
t1 <- getTime'
t1 <- getTime
occurrences <- getOccByNgramsOnlyFast' nId
listId
ngramsType
ngrams_terms
t2 <- getTime'
t2 <- getTime
liftBase $ hprint stderr
("getTableNgrams/setScores #ngrams=" % int % " time=" % timeSpecs % "\n")
("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
(length ngrams_terms) t1 t2
{-
occurrences <- getOccByNgramsOnlySlow nType nId
......@@ -574,7 +566,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
let scoresNeeded = needsScores orderBy
tableMap1 <- getNgramsTableMap listId ngramsType
t1 <- getTime'
t1 <- getTime
tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
. Map.mapWithKey ngramsElementFromRepo
......@@ -582,16 +574,16 @@ getTableNgrams _nType nId tabType listId limit_ offset
. filteredNodes
let fltrCount = length $ fltr ^. v_data . _NgramsTable
t2 <- getTime'
t2 <- getTime
tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
. setScores (not scoresNeeded)
. selectAndPaginate
t3 <- getTime'
t3 <- getTime
liftBase $ hprint stderr
("getTableNgrams total=" % timeSpecs
% " map1=" % timeSpecs
% " map2=" % timeSpecs
% " map3=" % timeSpecs
("getTableNgrams total=" % hasTime
% " map1=" % hasTime
% " map2=" % hasTime
% " map3=" % hasTime
% " sql=" % (if scoresNeeded then "map2" else "map3")
% "\n"
) t0 t3 t0 t1 t1 t2 t2 t3
......
src/Gargantext/API/Ngrams/List.hs
View file @ e55c38aa
......@@ -128,8 +128,5 @@ instance FromJSON WithFile where
parseJSON = genericParseJSON $ jsonOptions "_wf_"
instance ToJSON WithFile where
toJSON = genericToJSON $ jsonOptions "_wf_"
instance ToSchema WithFile where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
src/Gargantext/API/Ngrams/Prelude.hs
View file @ e55c38aa
......@@ -48,18 +48,13 @@ toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl
(roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing)
$ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns
roots' = catMaybes
$ map (\(t,nre) -> (,) <$> Just t
<*> Just (map toTerm $ unMSet
$ view nre_children nre
)
) roots
roots' = map (\(t,nre) -> (t, map toTerm $ unMSet $ view nre_children nre )) roots
children' = catMaybes
$ map (\(t,nre) -> (,) <$> view nre_root nre
<*> Just (map toTerm $ [t]
<> (unMSet $ view nre_children nre)
)
<*> Just (map toTerm $ [t]
<> (unMSet $ view nre_children nre)
)
) children
------------------------------------------
......@@ -68,4 +63,3 @@ patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet
unMSet :: MSet a -> [a]
unMSet (MSet a) = Map.keys a
src/Gargantext/API/Ngrams/Types.hs
View file @ e55c38aa
......@@ -20,39 +20,35 @@ import Data.Aeson.TH (deriveJSON)
import Data.Either (Either(..))
import Data.Foldable
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.Patch as PM
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),
PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,
MaybePatch(Mod), unMod, old, new)
import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,MaybePatch(Mod), unMod, old, new)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (IsString, fromString)
import Data.Swagger hiding (version, patch)
import Data.Text (Text, pack, strip)
import Data.Validity
import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError)
import GHC.Generics (Generic)
import Servant hiding (Patch)
import Servant.Job.Utils (jsonOptions)
import System.FileLock (FileLock)
import Test.QuickCheck (elements, frequency)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Protolude (maybeToEither)
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Gargantext.Core.Text (size)
import Gargantext.Core.Types (ListType(..), ListId, NodeId)
import Gargantext.Core.Types (TODO)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig)
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Protolude (maybeToEither)
import Servant hiding (Patch)
import Servant.Job.Utils (jsonOptions)
import System.FileLock (FileLock)
import Test.QuickCheck (elements, frequency)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.Patch as PM
import qualified Data.Set as Set
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
------------------------------------------------------------------------
......@@ -87,9 +83,8 @@ instance ToParamSchema TabType
instance ToJSON TabType
instance FromJSON TabType
instance ToSchema TabType
instance Arbitrary TabType
where
arbitrary = elements [minBound .. maxBound]
instance Arbitrary TabType where
arbitrary = elements [minBound .. maxBound]
instance FromJSONKey TabType where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey TabType where
......@@ -130,7 +125,6 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable)
instance IsHashable NgramsTerm where
hash (NgramsTerm t) = hash t
......
src/Gargantext/Prelude/Utils.hs
View file @ e55c38aa
......@@ -9,12 +9,13 @@ Portability : POSIX
TODO_1: qualitative tests (human)
TODO_2: quantitative tests (coded)
-}
module Gargantext.Prelude.Utils
where
import Control.Exception
import Control.Lens (view)
import Control.Monad.Random.Class (MonadRandom)
......@@ -22,6 +23,8 @@ import Control.Monad.Reader (MonadReader)
import Data.Aeson (ToJSON, toJSON)
import Data.Text (Text)
import Data.Tuple.Extra (both)
import Formatting.Clock (timeSpecs)
import Formatting.Internal (Format(..))
import GHC.IO (FilePath)
import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
import Gargantext.Database.Prelude (HasConfig(..))
......@@ -32,9 +35,16 @@ import System.Directory (createDirectoryIfMissing)
import System.IO.Error
import System.Random (newStdGen)
import qualified Data.Text as Text
import qualified System.Directory as SD
import qualified System.Clock as Clock (getTime, TimeSpec, Clock(..))
import qualified System.Directory as SD
import qualified System.Random.Shuffle as SRS
-------------------------------------------------------------------
hasTime :: Formatting.Internal.Format r (Clock.TimeSpec -> Clock.TimeSpec -> r)
hasTime = timeSpecs
getTime :: MonadBase IO m => m Clock.TimeSpec
getTime = liftBase $ Clock.getTime Clock.ProcessCPUTime
-------------------------------------------------------------------
-- | Main Class to use (just declare needed functions)
class GargDB a where
......
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