{-# LANGUAGE TypeFamilies #-}

module Data.Stream.StringLines
  ( StringPos (..),
    StringLines (..),
    fromString,
  )
where

import Data.Stream (Stream (..))

data StringPos = StringPos Int Int String

instance Show StringPos where
  show :: StringPos -> String
show (StringPos Int
l Int
c String
ls) =
    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
    where
      lnum :: String
lnum = Int -> String
forall a. Show a => a -> String
show (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      cnum :: String
cnum = 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
" | "
      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
ls 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
"^"

instance Eq StringPos where
  (StringPos Int
l1 Int
c1 String
_) == :: StringPos -> StringPos -> Bool
== (StringPos Int
l2 Int
c2 String
_) = 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 StringPos where
  compare :: StringPos -> StringPos -> Ordering
compare (StringPos Int
l1 Int
c1 String
_) (StringPos Int
l2 Int
c2 String
_) =
    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 :: String -> StringPos
start :: String -> StringPos
start String
s = Int -> Int -> String -> StringPos
StringPos Int
0 Int
0 (String -> StringPos) -> String -> StringPos
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s

adv :: StringPos -> StringPos
adv :: StringPos -> StringPos
adv (StringPos Int
l Int
c String
s) = Int -> Int -> String -> StringPos
StringPos Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s

nextl :: StringPos -> String -> StringPos
nextl :: StringPos -> String -> StringPos
nextl (StringPos Int
l Int
_ String
_) String
s = Int -> Int -> String -> StringPos
StringPos (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s)

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

instance Stream StringLines where
  type Item StringLines = Char
  type Pos StringLines = StringPos

  next :: StringLines -> Maybe (Item StringLines, StringLines)
next (StringLines [] StringPos
_) = Maybe (Item StringLines, StringLines)
forall a. Maybe a
Nothing
  next (StringLines (Char
'\n' : String
xs) StringPos
p) = (Char, StringLines) -> Maybe (Char, StringLines)
forall a. a -> Maybe a
Just (Char
'\n', String -> StringPos -> StringLines
StringLines String
xs (StringPos -> String -> StringPos
nextl StringPos
p String
xs))
  next (StringLines (Char
x : String
xs) StringPos
p) = (Char, StringLines) -> Maybe (Char, StringLines)
forall a. a -> Maybe a
Just (Char
x, String -> StringPos -> StringLines
StringLines String
xs (StringPos -> StringPos
adv StringPos
p))

  getPos :: StringLines -> Pos StringLines
getPos (StringLines String
_ StringPos
p) = Pos StringLines
StringPos
p

fromString :: String -> StringLines
fromString :: String -> StringLines
fromString String
s = String -> StringPos -> StringLines
StringLines String
s (String -> StringPos
start String
s)