{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Condensed but human-readable output (like 'Show').
module System.FS.Condense (
    Condense (..)
  , Condense1 (..)
  , condense1
  ) where

import qualified Data.ByteString as BS.Strict
import qualified Data.ByteString.Lazy as BS.Lazy
import           Data.Int
import           Data.List (intercalate)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text (Text, unpack)
import           Data.Void
import           Data.Word
import           Numeric.Natural
import           Text.Printf (printf)

{-------------------------------------------------------------------------------
  Main class
-------------------------------------------------------------------------------}

-- | Condensed but human-readable output
class Condense a where
  condense :: a -> String

{-------------------------------------------------------------------------------
  Rank-1 types
-------------------------------------------------------------------------------}

class Condense1 f where
  liftCondense :: (a -> String) -> f a -> String

-- | Lift the standard 'condense' function through the type constructor
condense1 :: (Condense1 f, Condense a) => f a -> String
condense1 :: forall (f :: * -> *) a. (Condense1 f, Condense a) => f a -> String
condense1 = (a -> String) -> f a -> String
forall a. (a -> String) -> f a -> String
forall (f :: * -> *) a.
Condense1 f =>
(a -> String) -> f a -> String
liftCondense a -> String
forall a. Condense a => a -> String
condense

{-------------------------------------------------------------------------------
  Default instances for deriving-via
-------------------------------------------------------------------------------}

newtype CondenseAsShow a = CondenseAsShow {forall a. CondenseAsShow a -> a
getCondenseAsShow :: a}
  deriving Int -> CondenseAsShow a -> ShowS
[CondenseAsShow a] -> ShowS
CondenseAsShow a -> String
(Int -> CondenseAsShow a -> ShowS)
-> (CondenseAsShow a -> String)
-> ([CondenseAsShow a] -> ShowS)
-> Show (CondenseAsShow a)
forall a. Show a => Int -> CondenseAsShow a -> ShowS
forall a. Show a => [CondenseAsShow a] -> ShowS
forall a. Show a => CondenseAsShow a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CondenseAsShow a -> ShowS
showsPrec :: Int -> CondenseAsShow a -> ShowS
$cshow :: forall a. Show a => CondenseAsShow a -> String
show :: CondenseAsShow a -> String
$cshowList :: forall a. Show a => [CondenseAsShow a] -> ShowS
showList :: [CondenseAsShow a] -> ShowS
Show

instance Show a => Condense (CondenseAsShow a) where
  condense :: CondenseAsShow a -> String
condense = CondenseAsShow a -> String
forall a. Show a => a -> String
show

{-------------------------------------------------------------------------------
  Instances for standard types
-------------------------------------------------------------------------------}

instance Condense Void where
  condense :: Void -> String
condense = Void -> String
forall a. Void -> a
absurd

instance Condense Text where
  condense :: Text -> String
condense = Text -> String
unpack

deriving via CondenseAsShow Bool instance Condense Bool
deriving via CondenseAsShow Int instance Condense Int
deriving via CondenseAsShow Int64 instance Condense Int64
deriving via CondenseAsShow Word instance Condense Word
deriving via CondenseAsShow Word32 instance Condense Word32
deriving via CondenseAsShow Word64 instance Condense Word64
deriving via CondenseAsShow Natural instance Condense Natural

instance Condense Rational where
  condense :: Rational -> String
condense = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.8f" (Double -> String) -> (Rational -> Double) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational :: Rational -> Double)

instance Condense1 [] where
  liftCondense :: forall a. (a -> String) -> [a] -> String
liftCondense a -> String
f [a]
as = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
as) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

instance Condense1 Set where
  liftCondense :: forall a. (a -> String) -> Set a -> String
liftCondense a -> String
f = (a -> String) -> [a] -> String
forall a. (a -> String) -> [a] -> String
forall (f :: * -> *) a.
Condense1 f =>
(a -> String) -> f a -> String
liftCondense a -> String
f ([a] -> String) -> (Set a -> [a]) -> Set a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

instance Condense a => Condense [a] where
  condense :: [a] -> String
condense = [a] -> String
forall (f :: * -> *) a. (Condense1 f, Condense a) => f a -> String
condense1

instance Condense a => Condense (Maybe a) where
  condense :: Maybe a -> String
condense (Just a
a) = String
"Just " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Condense a => a -> String
condense a
a
  condense Maybe a
Nothing  = String
"Nothing"

instance Condense a => Condense (Set a) where
  condense :: Set a -> String
condense = Set a -> String
forall (f :: * -> *) a. (Condense1 f, Condense a) => f a -> String
condense1

instance (Condense a, Condense b) => Condense (a, b) where
  condense :: (a, b) -> String
condense (a
a, b
b) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [a -> String
forall a. Condense a => a -> String
condense a
a, b -> String
forall a. Condense a => a -> String
condense b
b] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Condense a, Condense b, Condense c) => Condense (a, b, c) where
  condense :: (a, b, c) -> String
condense (a
a, b
b, c
c) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [a -> String
forall a. Condense a => a -> String
condense a
a, b -> String
forall a. Condense a => a -> String
condense b
b, c -> String
forall a. Condense a => a -> String
condense c
c] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Condense a, Condense b, Condense c, Condense d) => Condense (a, b, c, d) where
  condense :: (a, b, c, d) -> String
condense (a
a, b
b, c
c, d
d) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [a -> String
forall a. Condense a => a -> String
condense a
a, b -> String
forall a. Condense a => a -> String
condense b
b, c -> String
forall a. Condense a => a -> String
condense c
c, d -> String
forall a. Condense a => a -> String
condense d
d] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Condense a, Condense b, Condense c, Condense d, Condense e) => Condense (a, b, c, d, e) where
  condense :: (a, b, c, d, e) -> String
condense (a
a, b
b, c
c, d
d, e
e) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [a -> String
forall a. Condense a => a -> String
condense a
a, b -> String
forall a. Condense a => a -> String
condense b
b, c -> String
forall a. Condense a => a -> String
condense c
c, d -> String
forall a. Condense a => a -> String
condense d
d, e -> String
forall a. Condense a => a -> String
condense e
e] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Condense k, Condense a) => Condense (Map k a) where
  condense :: Map k a -> String
condense = [(k, a)] -> String
forall a. Condense a => a -> String
condense ([(k, a)] -> String) -> (Map k a -> [(k, a)]) -> Map k a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList

instance Condense BS.Strict.ByteString where
  condense :: ByteString -> String
condense ByteString
bs = ByteString -> String
forall a. Show a => a -> String
show ByteString
bs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.Strict.length ByteString
bs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"b>"

instance Condense BS.Lazy.ByteString where
  condense :: ByteString -> String
condense ByteString
bs = ByteString -> String
forall a. Show a => a -> String
show ByteString
bs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
BS.Lazy.length ByteString
bs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"b>"