<commit_before>{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Unison.Util.PrettyPrint where

import qualified Data.ListLike      as LL
import           Data.String        (IsString, fromString)
import           Unison.Util.Monoid (intercalateMap)
import Debug.Trace

-- !! TODO Have temporarily mangled this file during debugging.

-- A tree of `a` tokens, to be rendered to a character window by traversing the
-- leaves depth-first left-to-right, marked up with specifiers about where to
-- insert line-breaks.
data PrettyPrint a
  = Empty
  | Literal a
  | Append (PrettyPrint a) (PrettyPrint a)
  -- A subtree which can be rendered across multiple lines, and then indented.
  -- Example (\b_ for Breakable space):
  --   "if foo\b_then\b_" <> Nest "  " then_body
  | Nest a (PrettyPrint a)
  -- A delimiter token, which can optionally be replaced with a newline.
  | Breakable a
  -- A subtree for which we can decide to render broken or unbroken, separately
  -- from the enclosing tree.
  -- Example: (UInt64\b_-> UInt64\b_-> UInt64)
  | Group (PrettyPrint a)

unbrokenWidth :: LL.ListLike a b => PrettyPrint a -> Int
unbrokenWidth = \case
  Empty -> 0
  Literal a -> LL.length a
  Append a b -> unbrokenWidth a + unbrokenWidth b
  Nest _prefix a -> unbrokenWidth a
  Breakable a -> LL.length a
  Group a -> unbrokenWidth a

renderUnbroken :: Monoid a => PrettyPrint a -> a
renderUnbroken = \case
  Empty -> mempty
  Literal a -> a
  Append a b -> renderUnbroken a <> renderUnbroken b
  Nest _prefix a -> renderUnbroken a
  Breakable delim -> delim
  Group a -> renderUnbroken a

-- Render a `PrettyPrint a` into a rectangular window of width `width` characters.
-- `leading` characters of the first line have already been used (can be > width).
-- `start` is True if this is at the start of the outer-most term being printed.
renderBroken :: forall a b. (LL.ListLike a b, Eq b, Show a)  -- !! Show a
             => Bool -> Int -> Int -> b -> PrettyPrint a -> a
renderBroken start width leading lineSeparator p = let r = f p in 
                                                   trace ((show start) ++ ", " ++ (show width) ++ ", " ++ (show leading) ++ ", " ++ (show p) ++ ", " ++ (show $ unbrokenWidth p) ++ "\n" ++ (show r) ++ "\n\n\n") r where
 f = \case
  Empty -> LL.empty
  Literal a -> a
  Append a b ->
    let ra = renderBroken False width leading lineSeparator a
        trailing = lengthOfLastLine lineSeparator ra
    in ra <> renderBroken False width trailing lineSeparator b
  Nest prefix a ->
    if ((leading == 0) && (not start) && (width > LL.length prefix))
    then
      -- Indent the subtree.
      let ra = renderBroken False (width - LL.length prefix) 0 lineSeparator a
      in prefix <> replaceOneWithMany lineSeparator (LL.cons lineSeparator prefix) ra
    else renderBroken False width leading lineSeparator a
  Breakable _delim -> LL.singleton lineSeparator
  -- Going inside a Group can allow us to revert to unbroken rendering.
  Group a -> render' False width leading lineSeparator a

  --where  !!
 replaceOneWithMany :: (LL.FoldableLL a b, Eq b) => b -> a -> a -> a
 replaceOneWithMany target replacement list =
    LL.foldr (go target replacement) LL.empty list
      where go :: (LL.FoldableLL a b, Eq b) => b -> a -> b -> a -> a
            go target replacement b a =
              if b == target then LL.append replacement a else LL.cons b a

lengthOfLastLine :: (LL.ListLike a b, Eq b) => b -> a -> Int
lengthOfLastLine lineSeparator ra = 
  let ixs = LL.findIndices (==lineSeparator) ra in 
  (LL.length ra) - case ixs of 
                     [] -> 0
                     _  -> (LL.last ixs) + 1


render :: (LL.ListLike a Char, Show a) => Int -> PrettyPrint a -> a  -- !! show a
render width doc = render' True width 0 '\n' doc

-- Render broken only if necessary.
render' :: (LL.ListLike a b, Eq b, Show a) => Bool -> Int -> Int -> b -> PrettyPrint a -> a
render' start width leading lineSeparator doc =
  if unbrokenWidth doc <= width - leading
  then renderUnbroken doc
  else renderBroken start width leading lineSeparator doc

softbreak :: IsString a => PrettyPrint a
softbreak = Breakable " "

semicolon :: IsString a => PrettyPrint a
semicolon = Breakable "; "

comma :: IsString a => PrettyPrint a
comma = Breakable ", "

softbreaks :: (Foldable f, IsString a) => f (PrettyPrint a) -> PrettyPrint a
softbreaks = intercalateMap softbreak id

semicolons :: (Foldable f, IsString a) => f (PrettyPrint a) -> PrettyPrint a
semicolons = intercalateMap semicolon id

commas :: (Foldable f, IsString a) => f (PrettyPrint a) -> PrettyPrint a
commas = intercalateMap comma id

instance Semigroup (PrettyPrint a) where
  (<>) = mappend

instance Monoid (PrettyPrint a) where
  mempty = Empty
  mappend a b = Append a b

instance IsString a => IsString (PrettyPrint a) where
  fromString = Literal . fromString

instance Show (PrettyPrint a) where  -- !!
  show p = case p of
    Empty -> "Empty"
    Literal _ -> "Literal"
    Append _ _ -> "Append"
    Nest _ _ -> "Nest"
    Breakable _ -> "Breakable"
    Group _ -> "Group"
<commit_msg>Removal of debug code from PrettyPrint.hs<commit_after>{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Unison.Util.PrettyPrint where

import qualified Data.ListLike      as LL
import           Data.String        (IsString, fromString)
import           Unison.Util.Monoid (intercalateMap)

-- A tree of `a` tokens, to be rendered to a character window by traversing the
-- leaves depth-first left-to-right, marked up with specifiers about where to
-- insert line-breaks.
data PrettyPrint a
  = Empty
  | Literal a
  | Append (PrettyPrint a) (PrettyPrint a)
  -- A subtree which can be rendered across multiple lines, and then indented.
  -- Example (\b_ for Breakable space):
  --   "if foo\b_then\b_" <> Nest "  " then_body
  | Nest a (PrettyPrint a)
  -- A delimiter token, which can optionally be replaced with a newline.
  | Breakable a
  -- A subtree for which we can decide to render broken or unbroken, separately
  -- from the enclosing tree.
  -- Example: (UInt64\b_-> UInt64\b_-> UInt64)
  | Group (PrettyPrint a)

unbrokenWidth :: LL.ListLike a b => PrettyPrint a -> Int
unbrokenWidth = \case
  Empty -> 0
  Literal a -> LL.length a
  Append a b -> unbrokenWidth a + unbrokenWidth b
  Nest _prefix a -> unbrokenWidth a
  Breakable a -> LL.length a
  Group a -> unbrokenWidth a

renderUnbroken :: Monoid a => PrettyPrint a -> a
renderUnbroken = \case
  Empty -> mempty
  Literal a -> a
  Append a b -> renderUnbroken a <> renderUnbroken b
  Nest _prefix a -> renderUnbroken a
  Breakable delim -> delim
  Group a -> renderUnbroken a

-- Render a `PrettyPrint a` into a rectangular window of width `width` characters.
-- `leading` characters of the first line have already been used (can be > width).
-- `start` is True if this is at the start of the outer-most term being printed.
renderBroken :: forall a b. (LL.ListLike a b, Eq b) 
             => Bool -> Int -> Int -> b -> PrettyPrint a -> a
renderBroken start width leading lineSeparator = \case
  Empty -> LL.empty
  Literal a -> a
  Append a b ->
    let ra = renderBroken False width leading lineSeparator a
        trailing = lengthOfLastLine lineSeparator ra
    in ra <> renderBroken False width trailing lineSeparator b
  Nest prefix a ->
    if ((leading == 0) && (not start) && (width > LL.length prefix))
    then
      -- Indent the subtree.
      let ra = renderBroken False (width - LL.length prefix) 0 lineSeparator a
      in prefix <> replaceOneWithMany lineSeparator (LL.cons lineSeparator prefix) ra
    else renderBroken False width leading lineSeparator a
  Breakable _delim -> LL.singleton lineSeparator
  -- Going inside a Group can allow us to revert to unbroken rendering.
  Group a -> render' False width leading lineSeparator a

  where  
    replaceOneWithMany :: (LL.FoldableLL a b, Eq b) => b -> a -> a -> a
    replaceOneWithMany target replacement list =
      LL.foldr (go target replacement) LL.empty list
        where go :: (LL.FoldableLL a b, Eq b) => b -> a -> b -> a -> a
              go target replacement b a =
                if b == target then LL.append replacement a else LL.cons b a

    lengthOfLastLine :: (LL.ListLike a b, Eq b) => b -> a -> Int
    lengthOfLastLine lineSeparator ra = 
      let ixs = LL.findIndices (==lineSeparator) ra in 
      (LL.length ra) - case ixs of 
                         [] -> 0
                         _  -> (LL.last ixs) + 1


render :: (LL.ListLike a Char) => Int -> PrettyPrint a -> a
render width doc = render' True width 0 '\n' doc

-- Render broken only if necessary.
render' :: (LL.ListLike a b, Eq b) => Bool -> Int -> Int -> b -> PrettyPrint a -> a
render' start width leading lineSeparator doc =
  if unbrokenWidth doc <= width - leading
  then renderUnbroken doc
  else renderBroken start width leading lineSeparator doc

softbreak :: IsString a => PrettyPrint a
softbreak = Breakable " "

semicolon :: IsString a => PrettyPrint a
semicolon = Breakable "; "

comma :: IsString a => PrettyPrint a
comma = Breakable ", "

softbreaks :: (Foldable f, IsString a) => f (PrettyPrint a) -> PrettyPrint a
softbreaks = intercalateMap softbreak id

semicolons :: (Foldable f, IsString a) => f (PrettyPrint a) -> PrettyPrint a
semicolons = intercalateMap semicolon id

commas :: (Foldable f, IsString a) => f (PrettyPrint a) -> PrettyPrint a
commas = intercalateMap comma id

instance Semigroup (PrettyPrint a) where
  (<>) = mappend

instance Monoid (PrettyPrint a) where
  mempty = Empty
  mappend a b = Append a b

instance IsString a => IsString (PrettyPrint a) where
  fromString = Literal . fromString

instance Show (PrettyPrint a) where  -- !!
  show p = case p of
    Empty -> "Empty"
    Literal _ -> "Literal"
    Append _ _ -> "Append"
    Nest _ _ -> "Nest"
    Breakable _ -> "Breakable"
    Group _ -> "Group"

{'fraction_non_alphanumeric': 0.10132989281460897, 'fraction_numerical': 0.0023818975784041284, 'mean_word_length': 2.7784026996625424, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 155, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2973636', 'n_tokens_mistral': 3148, 'n_tokens_neox': 3035, 'n_words': 1232}