Breaking.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide #-}

-- This is an Internal module, hidden from Haddock
module Core.Text.Breaking
  ( breakWords,
    breakLines,
    breakPieces,
    intoPieces,
    intoChunks,
    isNewline,
  )
where

import Core.Text.Rope
import Data.Char (isSpace)
import Data.List (uncons)
import qualified Data.Text.Short as S (ShortText, break, empty, null, uncons)

-- |
-- Split a passage of text into a list of words. A line is broken wherever
-- there is one or more whitespace characters, as defined by "Data.Char"'s
-- 'Data.Char.isSpace'.
--
-- Examples:
--
-- @
-- λ> __breakWords \"This is a test\"__
-- [\"This\",\"is\",\"a\",\"test\"]
-- λ> __breakWords (\"St\" <> \"op and \" <> \"go left\")__
-- [\"Stop\",\"and\",\"go\",\"left\"]
-- λ> __breakWords emptyRope__
-- []
-- @
breakWords :: Rope -> [Rope]
breakWords = filter (not . nullRope) . breakPieces isSpace

-- |
-- Split a paragraph of text into a list of its individual lines. The
-- paragraph will be broken wherever there is a @'\n'@ character.
--
-- Blank lines will be preserved. Note that as a special case you do /not/ get
-- a blank entry at the end of the a list of newline terminated strings.
--
-- @
-- λ> __breakLines \"Hello\\n\\nWorld\\n\"__
-- [\"Hello\",\"\",\"World\"]
-- @
breakLines :: Rope -> [Rope]
breakLines text =
  let result = breakPieces isNewline text
      n = length result - 1
      (fore, aft) = splitAt n result
   in case result of
        [] -> []
        [p] -> [p]
        _ ->
          if aft == [""]
            then fore
            else result

-- |
-- Predicate testing whether a character is a newline. After
-- 'Data.Char.isSpace' et al in "Data.Char".
isNewline :: Char -> Bool
isNewline c = c == '\n'
{-# INLINEABLE isNewline #-}

-- |
-- Break a Rope into pieces whereever the given predicate function returns
-- @True@. If found, that character will not be included on either side. Empty
-- runs, however, *will* be preserved.
breakPieces :: (Char -> Bool) -> Rope -> [Rope]
breakPieces predicate text =
  let x = unRope text
      (final, result) = foldr (intoPieces predicate) (Nothing, []) x
   in case final of
        Nothing -> result
        Just piece -> intoRope piece : result

{-
Was the previous piece a match, or are we in the middle of a run of
characters? If we were, then join the previous run to the current piece
before processing into chunks.
-}
-- now for right fold
intoPieces :: (Char -> Bool) -> S.ShortText -> (Maybe S.ShortText, [Rope]) -> (Maybe S.ShortText, [Rope])
intoPieces predicate piece (stream, list) =
  let piece' = case stream of
        Nothing -> piece
        Just previous -> piece <> previous -- more rope, less text?
      pieces = intoChunks predicate piece'
   in case uncons pieces of
        Nothing -> (Nothing, list)
        Just (text, remainder) -> (Just (fromRope text), remainder ++ list)

--
-- λ> S.break isSpace "a d"
-- ("a"," d")
--
-- λ> S.break isSpace " and"
-- (""," and")
--
-- λ> S.break isSpace "and "
-- ("and"," ")
--
-- λ> S.break isSpace ""
-- ("","")
--
-- λ> S.break isSpace " "
-- (""," ")
--

{-
This was more easily expressed as

  let
    remainder' = S.drop 1 remainder
  in
    if remainder == " "

for the case when we were breaking on spaces. But generalized to a predicate
we have to strip off the leading character and test that its the only character;
this is cheaper than S.length etc.
-}
intoChunks :: (Char -> Bool) -> S.ShortText -> [Rope]
intoChunks _ piece | S.null piece = []
intoChunks predicate piece =
  let (chunk, remainder) = S.break predicate piece

      -- Handle the special case that a trailing " " (generalized to predicate)
      -- is the only character left.
      (trailing, remainder') = case S.uncons remainder of
        Nothing -> (False, S.empty)
        Just (c, remaining) ->
          if S.null remaining
            then (predicate c, S.empty)
            else (False, remaining)
   in if trailing
        then intoRope chunk : emptyRope : []
        else intoRope chunk : intoChunks predicate remainder'