{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Pretty.Diff
(
Config (Config, separatorText, wrapping),
Wrapping (Wrap, NoWrap),
pretty,
above,
below,
)
where
import qualified Data.Algorithm.Diff as Diff
import Data.Default (Default, def)
import Data.Function ((&))
import Data.List (transpose)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.String (IsString)
import qualified Data.Text as Text
import Data.Text (Text)
import Prelude
data Config
= Config
{
separatorText :: Maybe Text,
wrapping :: Wrapping
}
instance Default Config where
def = Config {separatorText = Nothing, wrapping = NoWrap}
data Wrapping
= Wrap Int
| NoWrap
pretty :: Show a => Config -> a -> a -> Text
pretty Config {separatorText, wrapping} x y =
[ above wrapping x y,
separator separatorText,
below wrapping x y
]
& mconcat
above :: Show a => Wrapping -> a -> a -> Text
above wrapping x y =
wrap wrapping [diffLine First down x y, Text.pack (show x)]
& filterEmptyLines
& Text.unlines
below :: Show a => Wrapping -> a -> a -> Text
below wrapping x y =
wrap wrapping [Text.pack (show y), diffLine Second up x y]
& filterEmptyLines
& Text.unlines
wrap :: Wrapping -> [Text] -> [Text]
wrap wrapping text =
case wrapping of
Wrap n ->
text
& fmap (Text.chunksOf n)
& interleaveLists
NoWrap -> text
down :: Char
down = '▼'
up :: Char
up = '▲'
data Position = First | Second
diffLine :: Show a => Position -> Char -> a -> a -> Text.Text
diffLine pos differ a b =
Diff.getDiff
(show a)
(show b)
& mapMaybe (toDiffLine pos differ)
& Text.pack
& Text.stripEnd
toDiffLine :: Position -> Char -> Diff.Diff a -> Maybe Char
toDiffLine pos c d =
case d of
Diff.First _ -> case pos of
First -> Just c
Second -> Nothing
Diff.Second _ -> case pos of
First -> Nothing
Second -> Just c
Diff.Both _ _ -> Just ' '
separator :: Maybe Text -> Text
separator maybeComparison =
[ "╷",
"│" <> (fromMaybe "" $ ((<>) " ") <$> maybeComparison),
"╵"
]
& Text.unlines
interleaveLists :: [[a]] -> [a]
interleaveLists = mconcat . transpose
filterEmptyLines :: [Text] -> [Text]
filterEmptyLines = filter (not . Text.null . Text.strip)