module Boilerplate.Doc (Doc, mkDoc, unDoc, upsert, upsertMany) where

import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import HsInspect.Types (Pos(..))

newtype Doc = Doc (Vector Text)

mkDoc :: Text -> Doc
mkDoc :: Text -> Doc
mkDoc = Vector Text -> Doc
Doc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

unDoc :: Doc -> Text
unDoc :: Doc -> Text
unDoc (Doc Vector Text
txt) = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ Vector Text
txt

-- from just after Pos to just before Pos, 1 indexed rows and columns
upsert :: Doc -> Pos -> Maybe Pos -> Text -> Doc
upsert :: Doc -> Pos -> Maybe Pos -> Text -> Doc
upsert (Doc Vector Text
lines') (Pos Int
sline Int
scol) Maybe Pos
to Text
txt =
  Vector Text -> Doc
Doc forall a b. (a -> b) -> a -> b
$ case forall a. Int -> Vector a -> (Vector a, Maybe (a, Vector a))
splitAt' (Int
sline forall a. Num a => a -> a -> a
- Int
1) Vector Text
lines' of
    (Vector Text
before, Maybe (Text, Vector Text)
Nothing) -> forall a. Vector a -> a -> Vector a
V.snoc Vector Text
before Text
txt
    (Vector Text
before, Just (Text
line, Vector Text
after)) ->
      let (Text
before', Text
after') = Int -> Text -> (Text, Text)
T.splitAt Int
scol Text
line
       in case Maybe Pos
to of
          Maybe Pos
Nothing -> Vector Text
before forall a. Semigroup a => a -> a -> a
<> forall a. a -> Vector a -> Vector a
V.cons ([Text] -> Text
T.concat [Text
before', Text
txt, Text
after']) Vector Text
after
          Just (Pos Int
elin Int
ecol) -> case forall a. Int -> Vector a -> (Vector a, Maybe (a, Vector a))
splitAt' (Int
elin forall a. Num a => a -> a -> a
- Int
1) Vector Text
lines' of
            (Vector Text
_, Maybe (Text, Vector Text)
Nothing) -> forall a. Vector a -> a -> Vector a
V.snoc Vector Text
before forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
before', Text
txt]
            (Vector Text
_, Just (Text
line', Vector Text
after'')) ->
              let (Text
_, Text
after''') = Int -> Text -> (Text, Text)
T.splitAt (Int
ecol forall a. Num a => a -> a -> a
- Int
1) Text
line'
               in Vector Text
before forall a. Semigroup a => a -> a -> a
<> forall a. a -> Vector a -> Vector a
V.cons ([Text] -> Text
T.concat [Text
before', Text
txt, Text
after''']) Vector Text
after''

splitAt' :: Int -> Vector a -> (Vector a, Maybe (a, Vector a))
splitAt' :: forall a. Int -> Vector a -> (Vector a, Maybe (a, Vector a))
splitAt' Int
i Vector a
v =
  let (Vector a
before, Vector a
after) = forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
i Vector a
v
   in if forall a. Vector a -> Bool
V.null Vector a
after
      then (Vector a
before, forall a. Maybe a
Nothing)
      else (Vector a
before, forall a. a -> Maybe a
Just (forall a. Vector a -> a
V.head Vector a
after, forall a. Vector a -> Vector a
V.tail Vector a
after))

-- applies all the upserts in reverse order, if the regions do not overlap and
-- are ascending then this amounts to applying all the upserts in parallel.
upsertMany :: Doc -> [(Pos, Maybe Pos, Text)] -> Doc
upsertMany :: Doc -> [(Pos, Maybe Pos, Text)] -> Doc
upsertMany = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Pos
from, Maybe Pos
to, Text
txt) Doc
acc -> Doc -> Pos -> Maybe Pos -> Text -> Doc
upsert Doc
acc Pos
from Maybe Pos
to Text
txt)