{-# LANGUAGE TypeFamilies #-}

module Data.Stream.TextLines
  ( TextPos (..),
    TextLines (..),
    fromText,
  )
where

import Data.Stream (Stream (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector, (!?))
import qualified Data.Vector as V

data TextPos = TextPos Int Int (Vector Text)

instance Show TextPos where
  show :: TextPos -> String
show (TextPos Int
l Int
c Vector Text
ls) =
    let (String
lnum, String
cnum) = (Int -> String
forall a. Show a => a -> String
show (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int -> String
forall a. Show a => a -> String
show (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        gut :: String
gut = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lnum) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | "
        ngut :: String
ngut = String
lnum String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | "
        line :: String
line = String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Text -> String
T.unpack (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ Vector Text
ls Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
!? Int
l
        snippet :: String
snippet = String
gut String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ngut String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
gut String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cursor
        cursor :: String
cursor = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
c Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^"
     in String
lnum String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cnum String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
snippet

instance Eq TextPos where
  (TextPos Int
l1 Int
c1 Vector Text
_) == :: TextPos -> TextPos -> Bool
== (TextPos Int
l2 Int
c2 Vector Text
_) = Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l2 Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c2

instance Ord TextPos where
  compare :: TextPos -> TextPos -> Ordering
compare (TextPos Int
l1 Int
c1 Vector Text
_) (TextPos Int
l2 Int
c2 Vector Text
_) =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l1 Int
l2 of
      Ordering
EQ -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
c1 Int
c2
      Ordering
x -> Ordering
x

start :: Text -> TextPos
start :: Text -> TextPos
start Text
s = Int -> Int -> Vector Text -> TextPos
TextPos Int
0 Int
0 (Vector Text -> TextPos) -> Vector Text -> TextPos
forall a b. (a -> b) -> a -> b
$ [Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList ([Text] -> Vector Text) -> [Text] -> Vector Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s

data TextLines = TextLines Text TextPos deriving (TextLines -> TextLines -> Bool
(TextLines -> TextLines -> Bool)
-> (TextLines -> TextLines -> Bool) -> Eq TextLines
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextLines -> TextLines -> Bool
$c/= :: TextLines -> TextLines -> Bool
== :: TextLines -> TextLines -> Bool
$c== :: TextLines -> TextLines -> Bool
Eq, Int -> TextLines -> ShowS
[TextLines] -> ShowS
TextLines -> String
(Int -> TextLines -> ShowS)
-> (TextLines -> String)
-> ([TextLines] -> ShowS)
-> Show TextLines
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextLines] -> ShowS
$cshowList :: [TextLines] -> ShowS
show :: TextLines -> String
$cshow :: TextLines -> String
showsPrec :: Int -> TextLines -> ShowS
$cshowsPrec :: Int -> TextLines -> ShowS
Show)

instance Stream TextLines where
  type Item TextLines = Char
  type Pos TextLines = TextPos

  next :: TextLines -> Maybe (Item TextLines, TextLines)
next (TextLines Text
t (TextPos Int
l Int
c Vector Text
ls)) =
    do
      (Char
nextChar, Text
t') <- Text -> Maybe (Char, Text)
T.uncons Text
t
      let (Int
l', Int
c') =
            if Char
nextChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
              then (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0)
              else (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      (Char, TextLines) -> Maybe (Char, TextLines)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
nextChar, Text -> TextPos -> TextLines
TextLines Text
t' (Int -> Int -> Vector Text -> TextPos
TextPos Int
l' Int
c' Vector Text
ls))

  getPos :: TextLines -> Pos TextLines
getPos (TextLines Text
_ TextPos
p) = Pos TextLines
TextPos
p

fromText :: Text -> TextLines
fromText :: Text -> TextLines
fromText Text
s = Text -> TextPos -> TextLines
TextLines Text
s (Text -> TextPos
start Text
s)