{-|
Description : Sequential access for variable-width encoded text data
Copyright   : (c) Hisaket VioletRed, 2022
License     : AGPL-3.0-or-later
Maintainer  : hisaket@outlook.jp
Stability   : experimental
Portability : POSIX

This module is for sequential access to variable-width encoded text data.

In sequential access for variable-width encoded (e.g. UTF-8) text data, It is
allowed to read data per line instead of by arbitrary size.
And, seek operation is only allowed to both ends of a file.

This restriction of safety assumes no writing from others while opening a file.
The behavior is undefined if the assumption is not satisfied. (An encoding corruption occurs typically.)
-}

module Polysemy.SequentialAccess.Text where

import qualified Polysemy.SequentialAccess as SA
import Data.Text ( Text )

type GetPosition = SA.GetPosition SA.TriPosition
type Seek = SA.Seek SA.Ends
type ReadLine = SA.Read Line Text
type ReadToEnd = SA.Read SA.ToEnd Text
type Extend = SA.Extend Text
type Append = SA.Append Text
type Clear = SA.Resize SA.NullSize

{- |A singleton that represents the size from the current position to the next
   line break.
-}
data Line = Line deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Eq Line
Eq Line
-> (Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmax :: Line -> Line -> Line
>= :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c< :: Line -> Line -> Bool
compare :: Line -> Line -> Ordering
$ccompare :: Line -> Line -> Ordering
$cp1Ord :: Eq Line
Ord, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

type Cursor = '[GetPosition, Seek]