module Bookhound.Utils.Text where

import qualified Data.Foldable as Foldable
import           Data.List     (intercalate)
import           Data.Text     (Text, pack)
import qualified Data.Text     as Text


class ToText a where
  toText :: a -> Text

instance ToText Char where
  toText :: Char -> Text
toText = Char -> Text
Text.singleton

instance ToText Int where
  toText :: Int -> Text
toText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance ToText Text where
  toText :: Text -> Text
toText = forall a. a -> a
id

instance ToText Integer where
  toText :: Integer -> Text
toText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance ToText Float where
  toText :: Float -> Text
toText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show

instance ToText Double where
  toText :: Double -> Text
toText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance {-# OVERLAPPING #-} ToText a => ToText [a] where
  toText :: [a] -> Text
toText = [Text] -> Text
Text.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToText a => a -> Text
toText

instance (ToText a, Foldable f, Functor f) => ToText (f a) where
  toText :: f a -> Text
toText = [Text] -> Text
Text.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToText a => a -> Text
toText


indent :: Int -> String -> String
indent :: Int -> String -> String
indent Int
n String
str = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ String -> String
indentLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
str
  where
    indentLine :: String -> String
indentLine = (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate Int
n String
" ") <>)