<commit_before>{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}

module Debug.Trace.LogTree.Process.UnixTree where

import Control.Exception.Base (assert)

import Debug.Trace.LogTree

----------------------------------------------------------------

-- The instances return header and footer lines for the call.  E.g.,
-- the header can include the initial state, function name, and
-- arguments, and the footer can include the return value and final
-- state.
class UnixTree call where
  callAndReturn :: LogTree UnixTree call "CallAndReturn" ->
    ([String] , [String])
  callAndError  :: LogTree UnixTree call "CallAndError" ->
    ([String] , [String])

unixTree :: Ex2T (LogTree UnixTree) -> [String]
unixTree (Ex2T t@(CallAndReturn {})) =
  layer' enter calls exit
  where
    (enter , exit) = callAndReturn t
    calls = map unixTree (_children t)
    layer' = layer ("┬ " , "├ ") ("├──" , "│  " , "└──" , "   ") ("╞ " , "╘ ")
unixTree (Ex2T t@(CallAndError {})) =
  layer' enter calls exit
  where
    (enter , exit) = callAndError t
    calls = map unixTree (_children' t ++
                          maybe [] (:[]) (_how t))
    layer' = layer ("┬ " , "├ ") ("├──" , "│  " , "└──" , "   ") ("╞ " , "╘ ")

----------------------------------------------------------------

-- Prefix first line with 'first' and rest of lines with 'rest'.
prefix :: String -> String -> [String] -> [String]
prefix _ _ [] = []
prefix first rest (l:ls) = (first ++ l) : map (rest ++) ls

-- Like 'prefix', but instead initial and last line are distinguished.
prefix' :: String -> String -> [String] -> [String]
prefix' init last = reverse . prefix last init . reverse

-- Layer a header 'hs', body 'bss', and footer 'fs'.
--
-- The 'bLastFirst' and 'bLastRest' are used only if the footer is
-- empty; otherwise, 'bFirst' and 'bRest' are used for all body lines.
--
-- Assumes the header is non-empty.
layer :: (String , String) -> (String , String , String , String) -> (String , String) ->
         [String] -> [[String]] -> [String] -> [String]
layer (hFirst , hRest) (bFirst , bRest , bLastFirst , bLastRest) (fInit , fLast) hs bss fs =
  hs' ++ concat bss' ++ fs'
  where
    hs' = assert (not . null $ hs) $ prefix hFirst hRest hs
    fs' = prefix' fInit fLast fs
    bss' = case bss of
      [] -> []
      _  ->
        if null fs<commit_msg>Make 'UnixTree' output more compact.<commit_after>{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}

module Debug.Trace.LogTree.Process.UnixTree where

import Control.Exception.Base (assert)

import Debug.Trace.LogTree

----------------------------------------------------------------

-- The instances return header and footer lines for the call.  E.g.,
-- the header can include the initial state, function name, and
-- arguments, and the footer can include the return value and final
-- state.
class UnixTree call where
  callAndReturn :: LogTree UnixTree call "CallAndReturn" ->
    ([String] , [String])
  callAndError  :: LogTree UnixTree call "CallAndError" ->
    ([String] , [String])

unixTree :: Ex2T (LogTree UnixTree) -> [String]
unixTree (Ex2T t@(CallAndReturn {})) =
  layer' enter calls exit
  where
    (enter , exit) = callAndReturn t
    calls = map unixTree (_children t)
unixTree (Ex2T t@(CallAndError {})) =
  layer' enter calls exit
  where
    (enter , exit) = callAndError t
    calls = map unixTree (_children' t ++
                          maybe [] (:[]) (_how t))

layer' :: [String] -> [[String]] -> [String] -> [String]
layer' = layer ("┬ " , "├ ") ("├─" , "│ " , "└─" , "  ") ("╞ " , "╘ ")

----------------------------------------------------------------

-- Prefix first line with 'first' and rest of lines with 'rest'.
prefix :: String -> String -> [String] -> [String]
prefix _ _ [] = []
prefix first rest (l:ls) = (first ++ l) : map (rest ++) ls

-- Like 'prefix', but instead initial and last line are distinguished.
prefix' :: String -> String -> [String] -> [String]
prefix' init last = reverse . prefix last init . reverse

-- Layer a header 'hs', body 'bss', and footer 'fs'.
--
-- The 'bLastFirst' and 'bLastRest' are used only if the footer is
-- empty; otherwise, 'bFirst' and 'bRest' are used for all body lines.
--
-- Assumes the header is non-empty.
layer :: (String , String) -> (String , String , String , String) -> (String , String) ->
         [String] -> [[String]] -> [String] -> [String]
layer (hFirst , hRest) (bFirst , bRest , bLastFirst , bLastRest) (fInit , fLast) hs bss fs =
  hs' ++ concat bss' ++ fs'
  where
    hs' = assert (not . null $ hs) $ prefix hFirst hRest hs
    fs' = prefix' fInit fLast fs
    bss' = case bss of
      [] -> []
      _  ->
        if null fs
{'fraction_non_alphanumeric': 0.2063555913113435, 'fraction_numerical': 0.0012067578439259854, 'mean_word_length': 2.439142461964039, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 40, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2547940', 'n_tokens_mistral': 1623, 'n_tokens_neox': 1597, 'n_words': 535}