{-# 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)