halfsplit-0.2.0.0: Phladiprelio/Halfsplit.hs

-- |
-- Module      :  Phladiprelio.Halfsplit
-- Copyright   :  (c) OleksandrZhabenko 2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--

{-# LANGUAGE NoImplicitPrelude #-}

{-# OPTIONS_HADDOCK -show-extensions #-}

module Phladiprelio.Halfsplit where

import GHC.Base
import GHC.Enum (fromEnum)
import GHC.Real (quot,quotRem)
import GHC.Num ((+),(-),abs)
import Data.List hiding (foldr)
import GHC.Int (Int8)
import Text.Show (Show(..))

-- | Converts the data that is an instance of 'Show' typeclass to be printed in two-column way.
halfsplit 
  :: (Show a, Eq b) 
  => (a -> b)
  -> Int8 
  -> [a] 
  -> String
halfsplit g m xs 
 | null xs = []
 | otherwise = 
    let (n, rr2) = quotRem (fromEnum m) (if m < 0 then -10 else 10)
        r = 
          case abs rr2 of
           1 -> let us = reverse ts in (if rrr == 0 then map show ys else replicate l0 ' ':map show ys, map show us)
           2 -> let us = (replicate (lt1 - ly1) [replicate l0 ' ']) `mappend` reverse (map reverse y1s) in (mconcat us, mconcat t1s)
           3 -> let us = (replicate (lt1 - ly1) [replicate l0 ' ']) `mappend` y1s
                    ks = reverse . map reverse $ t1s in (mconcat us, mconcat ks)
           4 -> let us = (replicate (lt2 - ly2) [replicate l0 ' ']) `mappend` reverse (map reverse y2s) in (mconcat us, mconcat t2s)
           5 -> let us = (replicate (lt2 - ly2) [replicate l0 ' ']) `mappend` y2s
                    ks = reverse . map reverse $ t2s in (mconcat us, mconcat ks)
           _ -> let us = reverse ys in (if rrr == 0 then map show us else replicate l0 ' ':map show us, map show ts) in (\(rs, qs) -> mergePartsLine n "\n" rs qs) $ r
              where (ys,ts) = splitAt l xs 
                    (l,rrr) = length xs `quotRem` 2
                    l0 = length . show . head $ xs 
                    rss = map (map show) . groupBy (\x y ->  g x == g y) $ xs
                    r1ss = intersperse [replicate l0 ' '] rss
                    l2 = (sum . map length $ rss) `quot` 2
                    l3 = (sum . map length $ r1ss) `quot` 2
                    (y1s,t1s,_) = splitGroups l2 rss
                    ly1 = sum . map length $ y1s
                    lt1 = sum . map length $ t1s
                    (y2s,t2s,_) = splitGroups l3 r1ss
                    ly2 = sum . map length $ y2s
                    lt2 = sum . map length $ t2s


mergePartsLine :: Int -> String -> [String] -> [String] -> String
mergePartsLine n newlined xs ys = intercalate newlined . zipWith (\x y -> x `mappend` (replicate n (if n < 0 then '\t' else ' ')) `mappend` y) xs $ ys

splitGroups :: Int -> [[a]] -> ([[a]], [[a]], Int)
splitGroups l tss = foldr h ([],[],0) tss
   where h js (rss,mss,k)
            | k < l = (rss, js:mss, k + length js)
            | otherwise = (js : rss, mss, k + length js)

showWithSpaces :: (Show a) => Int -> a -> String
showWithSpaces n x 
 | l < n = xs `mappend` replicate (n - l) ' '
 | otherwise = xs
    where xs = show x
          l = length xs