Block.hs

{-# LANGUAGE OverloadedStrings #-}

module Zwirn.Language.Block
  ( Block (..),
    BlockError,
    Line (..),
    getBlock,
    structureLines,
    getBlockContent,
    getLineIndent,
    getSingleLine,
    getBlockStart,
    getBlockEnd,
  )
where

{-
    Block.hs - layout sensitive representation of blocks of code
    Copyright (C) 2023, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T

-- | A Block of code is a non-empty list of lines of code
newtype Block = Block
  { bContent :: NE.NonEmpty Line
  }
  deriving (Show, Eq)

-- | A Line of code has a start line and an end line, if start /= end, it represents a multiline
data Line = Line
  { lStart :: Int,
    lEnd :: Int,
    lContent :: T.Text
  }
  deriving (Show, Eq)

type BlockError = String

-- | Get the start line of a block, assumes that the lines are ordered.
getBlockStart :: Block -> Int
getBlockStart (Block ls) = lStart $ NE.head ls

-- | Get the end line of a block, assumes that the lines are ordered.
getBlockEnd :: Block -> Int
getBlockEnd (Block ls) = lEnd $ NE.last ls

-- | Get the contents of a block by merging the contents of its lines
getBlockContent :: Block -> [T.Text]
getBlockContent (Block ls) = NE.toList $ NE.map lContent ls

-- | Given a line number and a list of blocks, get the block that starts before and ends after the line.
getBlock :: Int -> [Block] -> Either BlockError Block
getBlock _ [] = Left "no block of code at current line"
getBlock num (block : bs) =
  if start <= num && num <= end
    then Right block
    else getBlock num bs
  where
    start = getBlockStart block
    end = getBlockEnd block

-- | Given a line number and a non-empty list of lines, get the line that starts before and ends after the line number.
getLine' :: Int -> NE.NonEmpty Line -> Either BlockError Line
getLine' num (l@(Line st en _) NE.:| ls) =
  if st <= num && num <= en
    then Right l
    else case NE.nonEmpty ls of
      Just xs -> getLine' num xs
      Nothing -> Left "no line at current position"

getSingleLine :: Int -> [Block] -> Either BlockError Line
getSingleLine i bs = do
  (Block ls) <- getBlock i bs
  getLine' i ls

-- | Parsing Blocks of code is layout sensitive - this function merges lines of code into a single multiline
-- | whenever the indent of the first line is smaller than the indent of the following lines
structureLines :: NE.NonEmpty Line -> NE.NonEmpty Line
structureLines (l NE.:| ls) = mergeLines vs NE.:| rs
  where
    vs = l NE.:| takeWhile (\x -> getLineIndent x > getLineIndent l) ls
    rs = case NE.nonEmpty $ drop (length vs - 1) ls of
      Just xs -> NE.toList $ structureLines xs
      Nothing -> []

-- | checks how many spaces or tabs are at the start of the line content
getLineIndent :: Line -> Int
getLineIndent (Line _ _ lc) = T.length $ T.takeWhile (\c -> c `elem` (" \t" :: String)) lc

-- | combines lines to a single multiline by merging their content and adjusting the end line
mergeLines :: NE.NonEmpty Line -> Line
mergeLines ((Line lst len c) NE.:| ls) = Line lst end (T.concat $ c : map lContent ls)
  where
    end = if null ls then len else lEnd $ last ls