Internal.hs

{-|
Copyright   : (c) Hisaket VioletRed, 2022
License     : AGPL-3.0-or-later
Maintainer  : hisaket@outlook.jp
Stability   : experimental
Portability : POSIX
-}

module Polysemy.FS.Scoped.Text.Internal where

import qualified System.IO as IO
import Polysemy
    ( Member, Sem, embed, Embed, InterpretersFor, Members, interpret )
import qualified Polysemy.SequentialAccess.Text as SAT
import qualified Polysemy.SequentialAccess as SA
import Polysemy.Internal.Kind ( Append )
import Polysemy.Resource ( Resource )
import Control.Category ( (>>>) )
import Data.Functor ( (<&>) )
import Polysemy.FS.Scoped.Internal as Scoped
    ( ScopedFile, scopedFileToIO, seekToBegin, seekToEnd )
import qualified Polysemy.FS.Scoped as Scoped
import Polysemy.Internal.Sing ( KnownList )
import qualified Data.Text.IO as TIO
import qualified GHC.IO.Handle as IO


readToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAT.ReadLine ': SAT.ReadToEnd ': r) a -> Sem r a
readToIO h =
        interpret (\(SA.Read SAT.Line) -> embed $ TIO.hGetLine h)
    >>> interpret
            ( \(SA.Read SA.ToEnd) ->
                embed $ (TIO.hGetContents =<< IO.hDuplicate h) <* seekToEnd h
            )

extendToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAT.Extend ': r) a -> Sem r a
extendToIO h = interpret \(SA.Extend t) -> embed $ restoreCursor h $ seekToEnd h *> TIO.hPutStr h t


restoreCursor :: IO.Handle -> IO a -> IO a
restoreCursor h m = do
    before <- IO.hTell h
    m <* IO.hSeek h IO.AbsoluteSeek before

clearToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAT.Clear ': r) a -> Sem r a
clearToIO h = interpret \(SA.Resize SA.NullSize) -> embed $ IO.hSetFileSize h 0

cursorToIO :: Member (Embed IO) r => IO.Handle -> Sem (Append SAT.Cursor r) a -> Sem r a
cursorToIO h =
        interpret
            ( \SA.GetPosition -> embed $
                IO.hTell h >>= \case
                    0 ->  pure $ SA.End SA.TOF
                    _ ->  IO.hIsEOF h <&> \case
                            False -> SA.Intermediate
                            True -> SA.End SA.EOF
            )
    >>> interpret
            (\(SA.Seek end) -> embed $ case end of
                SA.TOF -> seekToBegin h
                SA.EOF -> seekToEnd h
            )

scopedTextFileToIO
    ::  (Members '[Embed IO, Resource] r, KnownList es)
    =>  IO.IOMode
    ->  (IO.Handle -> InterpretersFor es r)
    ->  (∀handle'. Sem (Scoped.ScopedFile mode es b handle' ': r) a)
    ->  Sem r a
scopedTextFileToIO = Scoped.scopedFileToIO IO.openFile