module Hedgehog.Golden.Internal.Source
  ( -- * Functions for producing diff
    addLineNumber
  , addLineNumbers
  , added
  , boxBottom
  , boxTop
  , removed
  , wrap
  -- * Colors
  , green
  , red
  , white
  , yellow
  ) where

import           Prelude

import           Data.Text (Text)
import qualified Data.Text as Text

addLineNumbers :: [Text] -> [Text]
addLineNumbers :: [Text] -> [Text]
addLineNumbers =
  ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text -> Text) -> (Int, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Text -> Text
addLineNumber) ([(Int, Text)] -> [Text])
-> ([Text] -> [(Int, Text)]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]

addLineNumber :: Int -> Text -> Text
addLineNumber :: Int -> Text -> Text
addLineNumber Int
lineNumber Text
line
  | Int
lineNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Text
"   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
lineNumber) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" │" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line
  | Int
lineNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 = Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
lineNumber) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" │" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line
  | Bool
otherwise = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
lineNumber) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" │" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line

wrap :: Text -> Text -> [Text] -> [Text]
wrap :: Text -> Text -> [Text] -> [Text]
wrap Text
start Text
end [Text]
mid = [Text
start] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mid [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
end]

boxTop :: Text
boxTop :: Text
boxTop = Int -> Text -> Text
Text.replicate Int
5 Text
"─" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"┬" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
55 Text
"─"

boxBottom :: Text
boxBottom :: Text
boxBottom = Int -> Text -> Text
Text.replicate Int
5 Text
"─" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"┴" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
55 Text
"─"

red :: Text -> Text
red :: Text -> Text
red Text
t = Text
"\ESC[31;1m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\ESC[0m"

yellow :: Text -> Text
yellow :: Text -> Text
yellow Text
t = Text
"\ESC[33;1m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\ESC[0m"

green :: Text -> Text
green :: Text -> Text
green Text
t = Text
"\ESC[32;1m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\ESC[0m"

white :: Text -> Text
white :: Text -> Text
white Text
t = Text
"\ESC[37;1m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\ESC[0m"

added :: Text -> Text
added :: Text -> Text
added = Text -> Text
green (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

removed :: Text -> Text
removed :: Text -> Text
removed  = Text -> Text
red (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)