formatted sequence difference

formattedSeqDiff.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.List as L (intersperse)
import Data.List (maximumBy)
import Data.Ord (comparing)

main :: IO ()
main = do
    T.putStrLn . formatSeqDiffs .
        seqDiffsCond (any (/= 0)) $ (^3) <$> [1..7]

seqDiff :: Num a => [a] -> [a]
seqDiff [] = []
seqDiff [x] = []
seqDiff (x1:x2:xs) = x2-x1 : seqDiff (x2:xs)

seqDiffs :: Num a => [a] -> [[a]]
seqDiffs = takeWhile (not . null) . iterate seqDiff

seqDiffsCond :: Num a => ([a] -> Bool) -> [a] -> [[a]]
seqDiffsCond p = takeWhilePlusOne p . seqDiffs
    where
        takeWhilePlusOne p = foldr (\x ys -> if p x then x:ys else [x]) []

formatSeqDiffs :: (Num a, Show a) => [[a]] -> T.Text
formatSeqDiffs [] = ""
formatSeqDiffs xs = T.unlines . shiftLeft $ T.concat <$> spaced xs'
    where
        xs' = (T.pack . show) <$$> xs
        spaced = indent . ((L.intersperse space) <$>) . align
        align = (center <$$>)
        indent = indent' 0
        indent' _ [] = []
        indent' n (x:xs) = (lead : x) : indent' (n+1) xs
            where lead = T.replicate n space
        space = T.replicate maxLen $ T.singleton char
        shiftLeft = (T.drop n <$>)
            where
                n = T.length $ T.takeWhile (== char) first
                first = center . head $ head xs'
        center = T.center maxLen char
        char = ' '
        maxLen = T.length . maximumBy (comparing T.length) $ concat xs'
        (<$$>) = (<$>) . (<$>)