{-|
Module      : Gargantext.Prelude.GargDB
Description : Useful Tools near Prelude of the project
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

TODO_1: qualitative  tests (human)
TODO_2: quantitative tests (coded)

-}

module Gargantext.Database.GargDB
  where

import Control.Lens (view)
import Data.Text qualified as Text
import Data.Tuple.Extra (both)
import Gargantext.Core.Config ( gc_datafilepath, HasConfig(..) )
import Gargantext.Prelude hiding (hash)
import Gargantext.Prelude.Crypto.Hash ( IsHashable(hash) )
import Prelude qualified
import System.Directory (createDirectoryIfMissing)
import System.Directory qualified as SD
import System.IO.Error ( isDoesNotExistError )
import System.Random (newStdGen)

-------------------------------------------------------------------
-- | Main Class to use (just declare needed functions)
class GargDB a where
  write :: a        -> IO ()
  read  :: FilePath -> IO a

  rm    :: (a, FilePath) -> IO ()
  mv    :: (a, FilePath) -> FilePath -> IO ()


-- | Why not this class too ?
class ToJSON parameters => GargDB' parameters gargdata where
  write' :: parameters -> gargdata -> IO ()
  read'  :: parameters -> IO gargdata

  rm'    :: gargdata -> parameters -> IO ()
  mv'    :: gargdata -> parameters -> parameters -> IO ()

-------------------------------------------------------------------
-- | Deprecated Class, use GargDB instead
class SaveFile a where
  saveFile' :: FilePath -> a -> IO ()

class ReadFile a where
  readFile' :: FilePath -> IO a

-------------------------------------------------------------------
-------------------------------------------------------------------
type GargFilePath = (FolderPath, FileName)
-- where
type FolderPath = FilePath
type FileName   = FilePath

           --------------------------------

dataFilePath :: (ToJSON a) => a -> GargFilePath
dataFilePath = toPath . hash . Prelude.show . toJSON

randomFilePath :: ( MonadReader  env m
                  , MonadBase IO     m
                  )
               => m GargFilePath
randomFilePath = do
  (foldPath, fileName)  <- liftBase
                         $ toPath
                         . hash
                         . Prelude.show
                         <$> newStdGen
  pure (foldPath, fileName)


-- | toPath' : how to hash text to path
{- example of use:
>>> toPath' (1,2) ("","helloword")
("/he","lloword")

>>> toPath' (2,2) ("","helloword")
("/he/ll","oword")

>>> toPath' (2,3) ("","helloword")
("/hel/low","ord")
-}
toPath :: Text -> (FolderPath, FileName)
toPath tx = both Text.unpack $ toPath' (2,3) ("", tx)

toPath' :: (Int,Int) -> (Text,Text) -> (Text,Text)
toPath' (n,m) (t,x) = foldl' (\tx _ -> toPath'' m tx) (t,x) [1..n]

toPath'' :: Int -> (Text, Text) -> (Text, Text)
toPath'' n (fp,fn) = (fp'',fn')
  where
    (fp',fn') = Text.splitAt n fn
    fp''      = Text.intercalate "/" [fp,fp']

-------------------------------------------------------------------
type DataPath   = FilePath
toFilePath :: FilePath -> FilePath -> FilePath
toFilePath fp1 fp2 = fp1 <> "/" <> fp2

-------------------------------------------------------------------

-- | Disk operations
-- | For example, this write file with a random filepath
-- better use a hash of json of Type used to parameter as input
-- the functions
writeFile :: ( MonadReader env m
             , HasConfig   env
             , MonadBase IO    m
             , SaveFile        a
             )
          => a -> m FilePath
writeFile a = do
  dataPath <- view $ hasConfig . gc_datafilepath

  (foldPath, fileName) <- randomFilePath

  let filePath     = toFilePath foldPath fileName
      dataFoldPath = toFilePath dataPath foldPath
      dataFileName = toFilePath dataPath filePath

  _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
  _ <- liftBase $ saveFile' dataFileName a

  pure filePath

---

-- | Example to read a file with Type
readGargFile :: ( MonadReader  env m
                , HasConfig    env
                , MonadBase IO     m
                , ReadFile         a
                )
                 => FilePath -> m a
readGargFile fp = do
  dataPath <- view $ hasConfig . gc_datafilepath
  liftBase $ readFile' $ toFilePath dataPath fp

---

rmFile :: ( MonadReader env m
          , MonadBase IO m
          , HasConfig env
          )
           => FilePath -> m ()
rmFile = onDisk_1 SD.removeFile

cpFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
           => FilePath -> FilePath -> m ()
cpFile = onDisk_2 SD.copyFile

---

mvFile :: ( MonadReader env m
          , MonadBase IO m
          , HasConfig env
          )
           => FilePath -> FilePath -> m ()
mvFile fp1 fp2 = do
  cpFile fp1 fp2
  rmFile fp1
  pure ()

------------------------------------------------------------------------
onDisk_1 :: ( MonadReader env m
            , MonadBase IO m
            , HasConfig env
            )
             => (FilePath -> IO ()) -> FilePath -> m ()
onDisk_1 action fp = do
  dataPath <- view $ hasConfig . gc_datafilepath
  liftBase $ action (toFilePath dataPath fp) `catch` handleExists
    where
      handleExists e
        | isDoesNotExistError e = pure ()
        | otherwise = throwIO e


onDisk_2 :: ( MonadReader env m
              , MonadBase IO m
              , HasConfig env
              )
        => (FilePath -> FilePath -> IO ())
        -> FilePath
        -> FilePath
        -> m ()
onDisk_2 action fp1 fp2 = do
  dataPath <- view $ hasConfig . gc_datafilepath
  let fp1' = toFilePath dataPath fp1
      fp2' = toFilePath dataPath fp2
  liftBase $ action fp1' fp2' `catch` handleExists
    where
      handleExists e
        | isDoesNotExistError e = pure ()
        | otherwise = throwIO e
------------------------------------------------------------------------