Doc.hs

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 = Doc . V.fromList . T.lines

unDoc :: Doc -> Text
unDoc (Doc txt) = T.unlines . V.toList $ txt

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

splitAt' :: Int -> Vector a -> (Vector a, Maybe (a, Vector a))
splitAt' i v =
  let (before, after) = V.splitAt i v
   in if V.null after
      then (before, Nothing)
      else (before, Just (V.head after, V.tail 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 = foldr (\(from, to, txt) acc -> upsert acc from to txt)