{- This file is part of Vervis.
 -
 - Written in 2023 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Data.Slab.Simple
    ( SimpleWorkshop ()
    , makeSimpleWorkshopConfig
    )
where

import Control.Concurrent
import Control.Monad
import Data.Foldable
import System.Directory
--import System.Directory.OsPath
import System.FilePath
--import System.OsPath

import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE

import Data.Slab.Backend

data SimpleWorkshop a = SimpleWorkshop
    { _swPath :: OsPath
    , _swMVar :: MVar (a, MVar OsPath)
    }

isSlab :: OsPath -> Bool
isSlab path = takeExtension path == ".slab" -- [osp|.slab|]

type OsPath = FilePath
decodeUtf = pure
encodeUtf = pure
unpack = id
toChar = id

instance Workshop SimpleWorkshop where
    data WorkshopSlab SimpleWorkshop a = SimpleSlab OsPath
    data WorkshopConfig SimpleWorkshop = SimpleConfig OsPath
    load (SimpleConfig dir) = do
        entries <- listDirectory dir
        let slabPaths = filter isSlab $ map (dir </>) entries
        mvar <- newEmptyMVar
        let next = dir </> "next" --[osp|next|]
        nextExists <- doesPathExist next
        next' <- decodeUtf next
        unless nextExists $ writeFile next' $ show (0 :: Integer)
        _ <- forkIO $ forever $ handleRequests mvar
        return
            ( SimpleWorkshop dir mvar
            , map SimpleSlab slabPaths
            )
        where
        handleRequests mvar = do
            (val, sendPath) <- takeMVar mvar
            slabPath <- do
                next <- decodeUtf $ dir </> "next" -- [osp|next|]
                n <- read <$> readFile next
                writeFile next $ show $ succ (n :: Integer)
                let wrap name = dir </> name <.> "slab" -- [osp|slab|]
                (new, bs) <-
                    case toSlabValue $ engrave val of
                        SlabText t ->
                            (, TE.encodeUtf8 t) <$>
                                encodeUtf (wrap $ show n ++ "t")
                        SlabByteString b ->
                            (, b) <$> encodeUtf (wrap $ show n ++ "b")
                new' <- decodeUtf new
                B.writeFile new' bs
                return new
            putMVar sendPath slabPath
    conceive (SimpleWorkshop _ mvar) val = do
        sendPath <- newEmptyMVar
        putMVar mvar (val, sendPath)
        new <- takeMVar sendPath
        return $ SimpleSlab new
    vacate (SimpleWorkshop dir _) = do
        entries <- listDirectory dir
        let slabPaths = filter isSlab $ map (dir </>) entries
            next = dir </> "next" -- [osp|next|]
        traverse_ removeFile slabPaths
        removeFile next

instance Slab (WorkshopSlab SimpleWorkshop) where
    retrieve (SimpleSlab path) = do
        b <- B.readFile path
        let sv =
                case reverse $ unpack $ takeBaseName path of
                    't':_ -> SlabText $ TE.decodeUtf8 b
                    'b':_ -> SlabByteString b
                    _ -> error $ "no b/t suffix in " ++ show path
        case see =<< fromSlabValue sv of
            Left e -> error $ "retrieve " ++ show path ++ " : " ++ T.unpack e
            Right val -> return val
    obliterate (SimpleSlab path) = removeFile path


{-
        TODO CONTINUE
        then, the atomic-durable one
        perhaps that's enough, no need for SQLite-based one?
        I thought it avoids file overload but if every actor has its own SQLite
        db anyway for the Box, then no harm
        Just need to make sure that slab file deletion is atomic
        finally, move on to creating a module that offers a system with slabs
        and boxes, it doesn't need to be perfect e.g. no need to support
        persistence of private sub-actors and no need for pretty types, just a
        function that wraps startTheater,spawnIO,spawn
        then use that to launch the DeliveryTheater in Vervis.Application
        And evolve the DeliveryTheater behavior to cache+retry
-}

makeSimpleWorkshopConfig :: OsPath -> WorkshopConfig SimpleWorkshop
makeSimpleWorkshopConfig = SimpleConfig