WIP refactoring

package.yaml

@@ -150,6 +150,7 @@ library:
   - full-text-search
   - fullstop
   - graphviz
+  - hashable
   - haskell-igraph
   - hlcm
   - hsparql

src/Gargantext/API/Metrics.hs

@@ -19,7 +19,8 @@ module Gargantext.API.Metrics
     where
 
 import Control.Lens
-import qualified Data.Map as Map
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HM
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Servant
@@ -78,7 +79,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
-      mChart = Map.lookup tabType scatterMap
+      mChart = HM.lookup tabType scatterMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -111,9 +112,9 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
   let
-    metrics      = map (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
-                 $ map normalizeLocal scores
-    listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
+    metrics      = fmap (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
+                 $ fmap normalizeLocal scores
+    listType t m = maybe (panic errorMsg) fst $ HM.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
 
   listId <- case maybeListId of
@@ -122,7 +123,7 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       scatterMap = hl ^. hl_scatter
-  _ <- updateHyperdata listId $ hl { _hl_scatter = Map.insert tabType (Metrics metrics) scatterMap }
+  _ <- updateHyperdata listId $ hl { _hl_scatter = HM.insert tabType (Metrics metrics) scatterMap }
 
   pure $ Metrics metrics
 
@@ -172,7 +173,7 @@ getChart cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let chartMap = node ^. node_hyperdata ^. hl_chart
-      mChart = Map.lookup tabType chartMap
+      mChart = HM.lookup tabType chartMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -209,7 +210,7 @@ updateChart' cId maybeListId tabType _maybeLimit = do
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
   h <- histoData cId
-  _ <- updateHyperdata listId $ hl { _hl_chart = Map.insert tabType (ChartMetrics h) chartMap }
+  _ <- updateHyperdata listId $ hl { _hl_chart = HM.insert tabType (ChartMetrics h) chartMap }
 
   pure $ ChartMetrics h
 
@@ -258,7 +259,7 @@ getPie cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let pieMap = node ^. node_hyperdata ^. hl_pie
-      mChart = Map.lookup tabType pieMap
+      mChart = HM.lookup tabType pieMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -296,7 +297,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
       pieMap = hl ^. hl_pie
 
   p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { _hl_pie = Map.insert tabType (ChartMetrics p) pieMap }
+  _ <- updateHyperdata listId $ hl { _hl_pie = HM.insert tabType (ChartMetrics p) pieMap }
 
   pure $ ChartMetrics p
 
@@ -355,7 +356,7 @@ getTree cId _start _end maybeListId tabType listType = do
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let treeMap = node ^. node_hyperdata ^. hl_tree
-      mChart = Map.lookup tabType treeMap
+      mChart = HM.lookup tabType treeMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -393,7 +394,7 @@ updateTree' cId maybeListId tabType listType = do
   let hl = node ^. node_hyperdata
       treeMap = hl ^. hl_tree
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { _hl_tree = Map.insert tabType (ChartMetrics t) treeMap }
+  _ <- updateHyperdata listId $ hl { _hl_tree = HM.insert tabType (ChartMetrics t) treeMap }
 
   pure $ ChartMetrics t
 

src/Gargantext/API/Ngrams/Types.hs

@@ -19,6 +19,7 @@ import Data.Aeson hiding ((.=))
 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)
@@ -60,6 +61,9 @@ data TabType   = Docs   | Trash   | MoreFav | MoreTrash
                | Contacts
   deriving (Bounded, Enum, Eq, Generic, Ord, Show)
 
+
+instance Hashable TabType
+
 instance FromHttpApiData TabType
    where
     parseUrlPiece "Docs"       = pure Docs

src/Gargantext/Core/Text/Metrics.hs

@@ -30,19 +30,20 @@ import qualified Data.Array.Accelerate as DAA
 import qualified Data.Array.Accelerate.Interpreter as DAA
 import qualified Data.Map  as Map
 
+import qualified Data.Vector as V
 import qualified Data.Vector.Storable as Vec
 
 type MapListSize = Int
 type InclusionSize = Int
 
-scored :: Ord t => Map (t,t) Int -> [Scored t]
+scored :: Ord t => Map (t,t) Int -> V.Vector (Scored t)
 scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
   where
     scored2map :: Ord t => Map (t,t) Int -> Map t (Vec.Vector Double)
     scored2map m = Map.fromList $ map (\(Scored t i s) -> (t, Vec.fromList [i,s])) $ scored' m
 
-    map2scored :: Ord t => Map t (Vec.Vector Double) -> [Scored t]
-    map2scored = map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . Map.toList
+    map2scored :: Ord t => Map t (Vec.Vector Double) -> V.Vector (Scored t)
+    map2scored = V.map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . V.fromList . Map.toList
 
 -- TODO change type with (x,y)
 data Scored ts = Scored

src/Gargantext/Core/Viz/Chart.hs

@@ -14,11 +14,12 @@ Portability : POSIX
 module Gargantext.Core.Viz.Chart
   where
 
-import Data.List (unzip, sortOn)
+import Data.List (sortOn)
 import Data.Map (toList)
 import qualified Data.List as List
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes)
+import qualified Data.Vector as V
 
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Admin.Config
@@ -42,8 +43,9 @@ import Gargantext.Core.Viz.Types
 histoData :: CorpusId -> Cmd err Histo
 histoData cId = do
   dates <- selectDocsDates cId
-  let (ls, css) = unzip
-                $ sortOn fst
+  let (ls, css) = V.unzip
+                $ V.fromList
+                $ sortOn fst -- TODO Vector.sortOn
                 $ toList
                 $ occurrencesWith identity dates
   pure (Histo ls css)
@@ -65,8 +67,8 @@ chartData cId nt lt = do
 
   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
                     <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
-  let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
-  pure (Histo dates (map round count))
+  let (dates, count) = V.unzip $ fmap (\(t,(d,_)) -> (t, d)) $ V.fromList $ Map.toList mapTerms
+  pure (Histo (dates) (round <$> count))
 
 
 treeData :: FlowCmdM env err m

src/Gargantext/Core/Viz/Types.hs

@@ -9,6 +9,8 @@ module Gargantext.Core.Viz.Types where
 
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
+import Data.Vector (Vector)
+import qualified Data.Vector as V
 import Protolude
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -23,8 +25,8 @@ data Chart = ChartHisto | ChartScatter | ChartPie
   deriving (Generic)
 
 -- TODO use UTCTime
-data Histo = Histo { histo_dates :: ![Text]
-                   , histo_count :: ![Int]
+data Histo = Histo { histo_dates :: !(Vector Text)
+                   , histo_count :: !(Vector Int)
                    }
   deriving (Show, Generic)
 
@@ -32,7 +34,7 @@ instance ToSchema Histo where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")
 instance Arbitrary Histo
   where
-    arbitrary = elements [ Histo ["2012"] [1]
-                         , Histo ["2013"] [1]
+    arbitrary = elements [ Histo (V.singleton "2012") (V.singleton 1)
+                         , Histo (V.singleton "2013") (V.singleton 1)
                          ]
 deriveJSON (unPrefix "histo_") ''Histo

src/Gargantext/Database/Action/Metrics.hs

@@ -18,6 +18,7 @@ module Gargantext.Database.Action.Metrics
 import Data.Map (Map)
 import qualified Data.Map    as Map
 import Data.Text (Text)
+import Data.Vector (Vector)
 
 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType)
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
@@ -33,7 +34,7 @@ import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScore
 
 getMetrics :: FlowCmdM env err m
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-            -> m (Map Text (ListType, Maybe Text), [Scored Text])
+            -> m (Map Text (ListType, Maybe Text), Vector (Scored Text))
 getMetrics cId maybeListId tabType maybeLimit = do
   (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
   pure (ngs, scored myCooc)

src/Gargantext/Database/Action/Metrics/Lists.hs

@@ -56,5 +56,5 @@ getMetrics' cId maybeListId tabType maybeLimit = do
   {-
   _ <- Learn.grid 100 110 metrics' metrics'
   --}
-  pure $ Map.fromListWith (<>) metrics
+  pure $ Map.fromListWith (<>) $ Vec.toList metrics
 

src/Gargantext/Database/Admin/Types/Hyperdata/List.hs

@@ -21,8 +21,10 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.List
   where
 
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Vector (Vector)
+--import qualified Data.Vector as V
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HM
 import Control.Applicative
 
 import Gargantext.Prelude
@@ -34,11 +36,11 @@ import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
 
 ------------------------------------------------------------------------
 data HyperdataList =
-  HyperdataList { _hl_chart   :: !(Map TabType (ChartMetrics Histo))
+  HyperdataList { _hl_chart   :: !(HashMap TabType (ChartMetrics Histo))
                 , _hl_list    :: !(Maybe Text)
-                , _hl_pie     :: !(Map TabType (ChartMetrics Histo))
-                , _hl_scatter :: !(Map TabType Metrics)
-                , _hl_tree    :: !(Map TabType (ChartMetrics [NgramsTree]))
+                , _hl_pie     :: !(HashMap TabType (ChartMetrics Histo))
+                , _hl_scatter :: !(HashMap TabType Metrics)
+                , _hl_tree    :: !(HashMap TabType (ChartMetrics (Vector NgramsTree)))
                 } deriving (Show, Generic)
   -- HyperdataList { _hl_chart   :: !(Maybe (ChartMetrics Histo))
   --               , _hl_list    :: !(Maybe Text)
@@ -49,11 +51,11 @@ data HyperdataList =
 
 defaultHyperdataList :: HyperdataList
 defaultHyperdataList =
-  HyperdataList { _hl_chart   = Map.empty
+  HyperdataList { _hl_chart   = HM.empty
                 , _hl_list    = Nothing
-                , _hl_pie     = Map.empty
-                , _hl_scatter = Map.empty
-                , _hl_tree    = Map.empty
+                , _hl_pie     = HM.empty
+                , _hl_scatter = HM.empty
+                , _hl_tree    = HM.empty
                 }
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Admin/Types/Metrics.hs

@@ -5,6 +5,8 @@ module Gargantext.Database.Admin.Types.Metrics where
 
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
+import Data.Vector (Vector)
+import qualified Data.Vector as V
 import Protolude
 import Test.QuickCheck.Arbitrary
 
@@ -13,15 +15,15 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 
 ----------------------------------------------------------------------------
 
-data Metrics = Metrics
-  { metrics_data :: [Metric]}
+newtype Metrics = Metrics
+  { metrics_data :: Vector Metric}
   deriving (Generic, Show)
 
 instance ToSchema Metrics where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "metrics_")
 instance Arbitrary Metrics
   where
-    arbitrary = Metrics <$> arbitrary
+    arbitrary = (Metrics . V.fromList) <$> arbitrary
 
 data Metric = Metric
   { m_label :: !Text
@@ -43,7 +45,7 @@ deriveJSON (unPrefix "metrics_") ''Metrics
 deriveJSON (unPrefix "m_") ''Metric
 
 
-data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
+newtype ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
   deriving (Generic, Show)
 
 instance (Typeable a, ToSchema a) => ToSchema (ChartMetrics a) where