[Prelude.Utils] Adding MonadReader HasSettings instance to read/write file functions.

src/Gargantext/API/Node.hs

@@ -32,9 +32,8 @@ module Gargantext.API.Node
   , HyperdataDocumentV3(..)
   ) where
 
-import Control.Lens (prism', set, view)
+import Control.Lens (prism', set)
 import Control.Monad ((>>))
-import Control.Monad.Reader (ask)
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Swagger
@@ -70,13 +69,16 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Data.Map as Map
 import qualified Gargantext.Database.Node.Update as U (update, Update(..))
 
+{--
 import qualified Gargantext.Text.List.Learn as Learn
 import qualified Data.Vector as Vec
+--}
 
-type GargServer api =
-  forall env m.
-    (CmdM env ServantErr m, HasRepo env, HasSettings env)
-    => ServerT api m
+type GargServer api = forall env m.
+    ( CmdM env ServantErr m
+    , HasRepo     env
+    , HasSettings env
+    ) => ServerT api m
 
 -------------------------------------------------------------------
 -- TODO-ACCESS: access by admin only.
@@ -406,11 +408,9 @@ getMetrics cId maybeListId tabType maybeLimit = do
     listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
   
-  --{-
+  {-
   let metrics' = Map.fromListWith (<>) $ map (\(Metric _ s1 s2 lt) -> (lt, [Vec.fromList [s1,s2]])) metrics
-  _ <- liftIO $ Learn.grid metrics'
-  en <- ask
-  printDebug "path" $  _fileFolder $ view repoSettings en
+  _ <- Learn.grid metrics'
   --}
   pure $ Metrics metrics
 

src/Gargantext/Prelude/Utils.hs

@@ -15,10 +15,14 @@ Portability : POSIX
 module Gargantext.Prelude.Utils
   where
 
---import Gargantext.Config (dataPath)
+import Control.Lens (view)
+import Control.Monad.Reader (MonadReader)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Text (Text)
+import Control.Monad.Reader (ask)
 import GHC.IO (FilePath)
 import Gargantext.Prelude
+import Gargantext.API.Settings
 import System.Random (newStdGen)
 import System.Directory (createDirectoryIfMissing)
 import qualified Data.ByteString.Lazy.Char8  as Char
@@ -28,9 +32,6 @@ import qualified Data.Text                   as Text
 type FolderPath = FilePath
 type FileName   = FilePath
 
--- | TODO Env Monad
-dataPath :: Text
-dataPath = "data"
 
 hash :: Text -> Text
 hash = Text.pack
@@ -56,16 +57,22 @@ class ReadFile a where
 -- we want to save
 type Empreinte = Text
 
-saveFile :: SaveFile a => a -> IO FilePath
+saveFile :: (MonadReader env m, MonadIO m, HasSettings env, SaveFile a)
+         => a -> m FilePath
 saveFile a = do
-  let n = 3
-  (fp,fn) <- (toPath n) . hash . Text.pack . show <$> newStdGen
-  let foldPath = (Text.unpack dataPath) <> "/" <> fp
-  let filePath = foldPath <> "/" <> fn
-  _ <- createDirectoryIfMissing True foldPath
-  _ <- saveFile' filePath a
+  (fp,fn) <- liftIO $ (toPath 3) . hash . Text.pack . show <$> newStdGen
+  
+  dataPath <- _fileFolder . (view repoSettings) <$> ask
+  let foldPath = dataPath <> "/" <> fp
+      filePath = foldPath <> "/" <> fn
+  
+  _ <- liftIO $ createDirectoryIfMissing True foldPath
+  _ <- liftIO $ saveFile' filePath a
+  
   pure filePath
 
-readFile :: ReadFile a => FilePath -> IO a
-readFile fp = readFile' ((Text.unpack dataPath) <> "/" <> fp)
-
+readFile :: (MonadReader env m, MonadIO m, HasSettings env, ReadFile a)
+         => FilePath -> m a
+readFile fp = do
+  dataPath <- _fileFolder . (view repoSettings) <$> ask
+  liftIO $ readFile' $ dataPath <> "/" <> fp

src/Gargantext/Text/List/Learn.hs

@@ -19,6 +19,9 @@ CSV parser for Gargantext corpus files.
 module Gargantext.Text.List.Learn
   where
 
+import Control.Monad.Reader (MonadReader)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Gargantext.API.Settings
 import Data.Map (Map)
 import Data.Maybe (maybe)
 import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId)
@@ -62,7 +65,7 @@ data Model = ModelSVM { model :: SVM.Model }
 
 instance SaveFile Model
   where
-    saveFile' p (ModelSVM m) = SVM.saveModel m p
+    saveFile' fp (ModelSVM m) = SVM.saveModel m fp
 
 instance ReadFile Model
   where
@@ -74,20 +77,21 @@ instance ReadFile Model
 -- shuffle list
 -- split list : train / test
 -- grid parameters on best result on test
-grid :: Map ListType [Vec.Vector Double] -> IO () -- Map (ListType, Maybe ListType) Int)
+grid :: (MonadReader env m, MonadIO m, HasSettings env) => Map ListType [Vec.Vector Double] -> m () -- Map (ListType, Maybe ListType) Int)
 grid m = do
   let
-    grid' :: Double -> Double
+    grid' :: (MonadReader env m, MonadIO m, HasSettings env)
+          => Double -> Double
           -> Map ListType [Vec.Vector Double]
-          -> IO (Double, (Double,Double))
+          -> m (Double, (Double,Double))
     grid' x y ls = do
-      model' <- trainList x y ls
+      model' <- liftIO $ trainList x y ls
       fp <- saveFile (ModelSVM model')
       printDebug "file" fp
       let (res, toGuess) = List.unzip $ List.concat 
                                       $ map (\(k,vs) -> zip (repeat k) vs)
                                       $ Map.toList ls
-      res' <- predictList model' toGuess
+      res' <- liftIO $ predictList model' toGuess
       pure (score'' $ score' $ List.zip res res', (x,y))
 
     {-