[OPTIM] after profiling, optimize serialisation

package.yaml

@@ -235,6 +235,7 @@ executables:
     - -rtsopts
     - -threaded
     - -with-rtsopts=-N
+    - -fprof-auto
     dependencies:
       - base
       - containers

src/Gargantext/API/Admin/Settings.hs

@@ -26,13 +26,14 @@ TODO-SECURITY: Critical
 module Gargantext.API.Admin.Settings
     where
 
+import Codec.Serialise (Serialise(), serialise)
 import Control.Concurrent
 import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
 import Control.Exception (finally)
 import Control.Lens
 import Control.Monad.Logger
 import Control.Monad.Reader
-import Data.Aeson
+import Data.Aeson hiding (encode)
 import Data.ByteString (ByteString)
 import Data.Either (either)
 import Data.Maybe (fromMaybe)
@@ -187,11 +188,11 @@ repoSnapshot = repoDir <> "/repo.json"
 
 -- | TODO add hard coded file in Settings
 -- This assumes we own the lock on repoSnapshot.
-repoSaverAction :: ToJSON a => a -> IO ()
+repoSaverAction :: Serialise a => a -> IO ()
 repoSaverAction a = do
   withTempFile "repos" "tmp-repo.json" $ \fp h -> do
     -- printDebug "repoSaverAction" fp
-    L.hPut h $ encode a
+    L.hPut h $ serialise a
     hClose h
     renameFile fp repoSnapshot
 

src/Gargantext/API/Ngrams.hs

@@ -96,6 +96,7 @@ module Gargantext.API.Ngrams
   )
   where
 
+import Codec.Serialise (Serialise())
 import Control.Category ((>>>))
 import Control.Concurrent
 import Control.Lens (makeLenses, makePrisms, Getter, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^..), (^?), (+~), (%~), (.~), (%=), sumOf, at, _Just, Each(..), itraverse_, both, forOf_, (%%~), (?~), mapped)
@@ -238,6 +239,8 @@ makeLenses ''NgramsRepoElement
 instance ToSchema NgramsRepoElement where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nre_")
 
+instance Serialise (MSet NgramsTerm)
+instance Serialise NgramsRepoElement
 
 data NgramsElement =
      NgramsElement { _ne_ngrams      :: NgramsTerm
@@ -443,6 +446,8 @@ instance ToSchema a => ToSchema (PatchSet a)
 
 type AddRem = Replace (Maybe ())
 
+instance Serialise AddRem
+
 remPatch, addPatch :: AddRem
 remPatch = replace (Just ()) Nothing
 addPatch = replace Nothing (Just ())
@@ -452,6 +457,7 @@ isRem = (== remPatch)
 
 type PatchMap = PM.PatchMap
 
+
 newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
   deriving (Eq, Show, Generic, Validity, Semigroup, Monoid,
             Transformable, Composable)
@@ -459,6 +465,9 @@ newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
 type ConflictResolutionPatchMSet a = a -> ConflictResolutionReplace (Maybe ())
 type instance ConflictResolution (PatchMSet a) = ConflictResolutionPatchMSet a
 
+instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
+instance (Serialise a, Ord a) => Serialise (PatchMSet a)
+
 -- TODO this breaks module abstraction
 makePrisms ''PM.PatchMap
 
@@ -528,6 +537,10 @@ instance ToSchema  NgramsPatch where
 instance Arbitrary NgramsPatch where
   arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary)
 
+instance Serialise NgramsPatch
+instance Serialise (Replace ListType)
+instance Serialise ListType
+
 type NgramsPatchIso = PairPatch (PatchMSet NgramsTerm) (Replace ListType)
 
 _NgramsPatch :: Iso' NgramsPatch NgramsPatchIso
@@ -578,6 +591,9 @@ instance Action NgramsPatch (Maybe NgramsRepoElement) where
 newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
   deriving (Eq, Show, Generic, ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable)
 
+instance Serialise NgramsTablePatch
+instance Serialise (PatchMap NgramsTerm NgramsPatch)
+
 instance FromField NgramsTablePatch
   where
     fromField = fromField'
@@ -736,6 +752,8 @@ instance (ToJSON s, ToJSON p) => ToJSON (Repo s p) where
   toJSON     = genericToJSON     $ unPrefix "_r_"
   toEncoding = genericToEncoding $ unPrefix "_r_"
 
+instance (Serialise s, Serialise p) => Serialise (Repo s p)
+
 makeLenses ''Repo
 
 initRepo :: Monoid s => Repo s p
@@ -745,6 +763,9 @@ type NgramsRepo       = Repo NgramsState NgramsStatePatch
 type NgramsState      = Map      TableNgrams.NgramsType (Map NodeId NgramsTableMap)
 type NgramsStatePatch = PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch)
 
+instance Serialise (PM.PatchMap NodeId NgramsTablePatch)
+instance Serialise NgramsStatePatch
+
 initMockRepo :: NgramsRepo
 initMockRepo = Repo 1 s []
   where

src/Gargantext/Database/Action/Node.hs

@@ -91,7 +91,7 @@ mkNodeWithParent NodeList (Just i) uId name =
     where
       hd = defaultAnnuaire
 
-mkNodeWithParent NodeGraph (Just i) uId name =
+mkNodeWithParent NodeGraph (Just i) uId _name =
    insertNodesWithParentR (Just i) [node NodeGraph "Graph" hd Nothing uId]
     where
       hd = arbitraryGraph

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

@@ -25,6 +25,7 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Node
   where
 
+import Codec.Serialise (Serialise())
 import Control.Applicative ((<*>))
 import Control.Lens hiding (elements, (&))
 import Control.Monad (mzero)
@@ -138,6 +139,8 @@ pgNodeId = O.pgInt4 . id2int
 newtype NodeId = NodeId Int
   deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
 
+instance Serialise NodeId
+
 instance ToField NodeId where
   toField (NodeId n) = toField n
 

src/Gargantext/Database/Schema/Ngrams.hs

@@ -27,6 +27,7 @@ Ngrams connection to the Database.
 module Gargantext.Database.Schema.Ngrams
   where
 
+import Codec.Serialise (Serialise())
 import Control.Lens (makeLenses, over)
 import Control.Monad (mzero)
 import Data.Aeson
@@ -90,6 +91,8 @@ ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { _ngrams_id    = optional "id"
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
   deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 
+instance Serialise NgramsType
+
 ngramsTypes :: [NgramsType]
 ngramsTypes = [minBound..]