{-|
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 :: Handle -> Sem (ReadLine : ReadToEnd : r) a -> Sem r a
readToIO Handle
h =
        (forall (rInitial :: EffectRow) x.
 ReadLine (Sem rInitial) x -> Sem (ReadToEnd : r) x)
-> Sem (ReadLine : ReadToEnd : r) a -> Sem (ReadToEnd : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\(SA.Read SAT.Line) -> IO Text -> Sem (ReadToEnd : r) Text
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Text -> Sem (ReadToEnd : r) Text)
-> IO Text -> Sem (ReadToEnd : r) Text
forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
h)
    (Sem (ReadLine : ReadToEnd : r) a -> Sem (ReadToEnd : r) a)
-> (Sem (ReadToEnd : r) a -> Sem r a)
-> Sem (ReadLine : ReadToEnd : r) a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (rInitial :: EffectRow) x.
 ReadToEnd (Sem rInitial) x -> Sem r x)
-> Sem (ReadToEnd : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret
            ( \(SA.Read SA.ToEnd) ->
                IO Text -> Sem r Text
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Text -> Sem r Text) -> IO Text -> Sem r Text
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Text
TIO.hGetContents (Handle -> IO Text) -> IO Handle -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO Handle
IO.hDuplicate Handle
h) IO Text -> IO () -> IO Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Handle -> IO ()
seekToEnd Handle
h
            )

extendToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAT.Extend ': r) a -> Sem r a
extendToIO :: Handle -> Sem (Extend : r) a -> Sem r a
extendToIO Handle
h = (forall (rInitial :: EffectRow) x.
 Extend (Sem rInitial) x -> Sem r x)
-> Sem (Extend : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \(SA.Extend t) -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO () -> IO ()
forall a. Handle -> IO a -> IO a
restoreCursor Handle
h (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
seekToEnd Handle
h IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> Text -> IO ()
TIO.hPutStr Handle
h Text
t


restoreCursor :: IO.Handle -> IO a -> IO a
restoreCursor :: Handle -> IO a -> IO a
restoreCursor Handle
h IO a
m = do
    Integer
before <- Handle -> IO Integer
IO.hTell Handle
h
    IO a
m IO a -> IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
h SeekMode
IO.AbsoluteSeek Integer
before

clearToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAT.Clear ': r) a -> Sem r a
clearToIO :: Handle -> Sem (Clear : r) a -> Sem r a
clearToIO Handle
h = (forall (rInitial :: EffectRow) x.
 Clear (Sem rInitial) x -> Sem r x)
-> Sem (Clear : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \(SA.Resize SA.NullSize) -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Handle -> Integer -> IO ()
IO.hSetFileSize Handle
h Integer
0

cursorToIO :: Member (Embed IO) r => IO.Handle -> Sem (Append SAT.Cursor r) a -> Sem r a
cursorToIO :: Handle -> Sem (Append Cursor r) a -> Sem r a
cursorToIO Handle
h =
        (forall (rInitial :: EffectRow) x.
 GetPosition TriPosition (Sem rInitial) x -> Sem (Seek Ends : r) x)
-> Sem (GetPosition TriPosition : Seek Ends : r) a
-> Sem (Seek Ends : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret
            ( \GetPosition TriPosition (Sem rInitial) x
SA.GetPosition -> IO TriPosition -> Sem (Seek Ends : r) TriPosition
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO TriPosition -> Sem (Seek Ends : r) TriPosition)
-> IO TriPosition -> Sem (Seek Ends : r) TriPosition
forall a b. (a -> b) -> a -> b
$
                Handle -> IO Integer
IO.hTell Handle
h IO Integer -> (Integer -> IO TriPosition) -> IO TriPosition
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Integer
0 ->  TriPosition -> IO TriPosition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TriPosition -> IO TriPosition) -> TriPosition -> IO TriPosition
forall a b. (a -> b) -> a -> b
$ Ends -> TriPosition
SA.End Ends
SA.TOF
                    Integer
_ ->  Handle -> IO Bool
IO.hIsEOF Handle
h IO Bool -> (Bool -> TriPosition) -> IO TriPosition
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                            Bool
False -> TriPosition
SA.Intermediate
                            Bool
True -> Ends -> TriPosition
SA.End Ends
SA.EOF
            )
    (Sem (GetPosition TriPosition : Seek Ends : r) a
 -> Sem (Seek Ends : r) a)
-> (Sem (Seek Ends : r) a -> Sem r a)
-> Sem (GetPosition TriPosition : Seek Ends : r) a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (rInitial :: EffectRow) x.
 Seek Ends (Sem rInitial) x -> Sem r x)
-> Sem (Seek Ends : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret
            (\(SA.Seek end) -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ case Ends
end of
                Ends
SA.TOF -> Handle -> IO ()
seekToBegin Handle
h
                Ends
SA.EOF -> Handle -> IO ()
seekToEnd Handle
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 :: IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
scopedTextFileToIO = (FilePath -> IOMode -> IO Handle)
-> IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
forall k (r :: EffectRow) (es :: EffectRow) (mode :: k) b a.
(Members '[Embed IO, Resource] r, KnownList es) =>
(FilePath -> IOMode -> IO Handle)
-> IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
Scoped.scopedFileToIO FilePath -> IOMode -> IO Handle
IO.openFile