{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures#-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

{-| Module  : FiniteCategories
Description : A simple typeclass for things to be pretty printed.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

A simple typeclass for things to be pretty printed. Categories objects and arrows should be pretty printable to be exported with graphviz.
Different objects should be pretty printed into different strings or the graphviz export might be wrong.
-}
module Math.IO.PrettyPrint
(
    PrettyPrint(..),
    pp,
    ppi,
    indentation,
    pprintFunction
)
where
    import              Data.List  (intercalate)
    import qualified    Data.Set                                            as Set
    import qualified    Data.WeakSet                                        as WSet
    import qualified    Data.WeakMap                                        as WMap
    import qualified    Data.Text                                           as Text
    import              Data.Int
    import              Data.Word
    import              Data.Simplifiable
    
    import              GHC.Generics
    
    import              Numeric.Natural
    
    -- | The typeclass of things that can be pretty printed.
    --
    -- 'pprint' takes a level of verbosity as its first argument from the less verbose 'pprint 0' to the most verbose 'pprint n'.
    class PrettyPrint a where
        -- | Pretty print an element of type 'a' with a given verbosity level. 0 is the less verbose possible.
        pprint :: Int -> a -> String
        
        -- | Pretty print with a given level of indentation an element of type 'a' with a given verbosity level. See 'pprintIndent' for usage.
        pprintWithIndentations :: Int -- ^ The current verbosity level
                     -> Int -- ^ Original verbosity level
                     -> String -- ^ The indentation used
                     -> a -- ^ The object to pretty print
                     -> String
        
        -- | Pretty print with indentation an element of type 'a' with a given verbosity level.
        pprintIndent :: Int -> a -> String
        pprintIndent v a = pprintWithIndentations v v "| " a
        
        default pprint :: (Generic a, GPrettyPrint (Rep a)) => Int -> a -> String
        pprint v a = gpprint v (from a)
        
        default pprintWithIndentations :: (Generic a, GPrettyPrint (Rep a)) => Int -> Int -> String -> a -> String
        pprintWithIndentations cv ov indent a = gpprintWithIndentations cv ov indent (from a)
    
    -- | PutStrLn composed with pprint. Takes a verbosity level as its first argument.
    pp :: (PrettyPrint a) => Int -> a -> IO ()
    pp v a = putStrLn $ pprint v a
        
    -- | PutStrLn composed with pprintIndent. Takes a verbosity level as its first argument.
    ppi :: (PrettyPrint a) => Int -> a -> IO ()
    ppi v a = putStrLn $ pprintIndent v a
        
    -- | Add indentation at the begining of a string.
    indentation :: Int -> String -> String
    indentation i s = concat $ replicate i s
        
    class GPrettyPrint f where
        gpprint :: Int -> f a -> String
        gpprintWithIndentations :: Int -> Int -> String -> f a -> String
        
    instance GPrettyPrint U1 where
        gpprint _ U1 = []
        gpprintWithIndentations _ _ _ U1 = []
        
    instance (GPrettyPrint a, GPrettyPrint b) => GPrettyPrint (a :*: b) where
        -- gpprint 0 _ = "..."
        gpprint v (a :*: b) = gpprint v a ++ ", " ++ gpprint v b
        
        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        gpprintWithIndentations cv ov indent (a :*: b) = gpprintWithIndentations cv ov indent a ++ gpprintWithIndentations cv ov indent b
        
    instance (GPrettyPrint a, GPrettyPrint b) => GPrettyPrint (a :+: b) where
        -- gpprint 0 _ = "..."
        gpprint v (L1 a) = gpprint v a
        gpprint v (R1 b) = gpprint v b
        
        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        gpprintWithIndentations cv ov indent (L1 a) = gpprintWithIndentations cv ov indent a
        gpprintWithIndentations cv ov indent (R1 b) = gpprintWithIndentations cv ov indent b
        
        
    instance (GPrettyPrint a) => GPrettyPrint (S1 c a) where
        -- gpprint 0 _ = "..."
        gpprint v (M1 x) = gpprint v x
        
        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        gpprintWithIndentations cv ov indent (M1 x) = gpprintWithIndentations cv ov indent x
        
    instance (GPrettyPrint a) => GPrettyPrint (D1 c a) where
        -- gpprint 0 _ = "..."
        gpprint v (M1 x) = gpprint v x
        
        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        gpprintWithIndentations cv ov indent (M1 x) = gpprintWithIndentations cv ov indent x
    
    instance (Constructor c, GPrettyPrint a) => GPrettyPrint (C1 c a) where
        gpprint v c@(M1 x) 
            | null innerString = conName c
            | otherwise = conName c ++ "("++ innerString ++")"
            where
                innerString = gpprint v x
        
        gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        gpprintWithIndentations cv ov indent c@(M1 x)
            | null innerString = indentation (ov - cv) indent ++ conName c ++ "\n"
            | otherwise = indentation (ov - cv) indent ++ conName c ++ "\n" ++ innerString
            where
                innerString = gpprintWithIndentations cv ov indent x

    instance (PrettyPrint a) => GPrettyPrint (K1 i a) where
        gpprint 0 _ = "..."
        gpprint v (K1 x) = pprint (v - 1) x
        
        gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        gpprintWithIndentations cv ov indent (K1 x) = pprintWithIndentations (cv-1) ov indent x
        
        
        
        
        
        
    instance (PrettyPrint a) => PrettyPrint [a] where
        -- pprint 0 _ = "..."
        pprint v xs = "[" ++ intercalate "," (pprint (v) <$> xs) ++ "]"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "[\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> xs) ++ "\n" ++ indentation (ov - cv) indent ++ "]\n"
        
    instance (PrettyPrint a) => PrettyPrint (Maybe a) where
        -- pprint 0 _ = "..."
        pprint _ Nothing = "Nothing"
        pprint v (Just x) = pprint v x
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent Nothing = indentation (ov - cv) indent ++ "Nothing\n"
        pprintWithIndentations cv ov indent (Just x) = pprintWithIndentations cv ov indent x ++ "\n"
        
    instance (PrettyPrint a, PrettyPrint b) => PrettyPrint (Either a b) where
        pprint 0 _ = "..."
        pprint v (Left a) = pprint v a
        pprint v (Right a) = pprint v a
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent (Left a) = pprintWithIndentations cv ov indent a ++"\n"
        pprintWithIndentations cv ov indent (Right a) = pprintWithIndentations cv ov indent a ++"\n"
        
    instance (PrettyPrint a, PrettyPrint b) => PrettyPrint (a,b) where
        pprint 0 _ = "..."
        pprint v (a,b) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ ")"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent (a,b) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent b ++ indentation (ov - cv) indent ++ ")\n"
    
    instance (PrettyPrint a, PrettyPrint b, PrettyPrint c) => PrettyPrint (a,b,c) where
        pprint 0 _ = "..."
        pprint v (a,b,c) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ "," ++ pprint (v-1) c ++ ")"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent (a,b,c) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent b) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent c ++ indentation (ov - cv) indent ++ ")\n"
        
    instance (PrettyPrint a, PrettyPrint b, PrettyPrint c, PrettyPrint d) => PrettyPrint (a,b,c,d) where
        pprint 0 _ = "..."
        pprint v (a,b,c,d) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ "," ++ pprint (v-1) c ++ "," ++ pprint (v-1) d ++ ")"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent (a,b,c,d) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent b) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent c) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent d ++ indentation (ov - cv) indent ++ ")\n"
        
    instance (PrettyPrint a, PrettyPrint b, PrettyPrint c, PrettyPrint d, PrettyPrint e) => PrettyPrint (a,b,c,d,e) where
        pprint 0 _ = "..."
        pprint v (a,b,c,d,e) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ "," ++ pprint (v-1) c ++","++ pprint (v-1) d ++ "," ++ pprint (v-1) e ++ ")"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent (a,b,c,d,e) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent b) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent c) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent d) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent e ++ indentation (ov - cv) indent ++ ")\n"
        
    instance (PrettyPrint a) => PrettyPrint (Set.Set a) where
        -- pprint 0 _ = "..."
        pprint v xs = "{" ++ intercalate "," (pprint (v) <$> (Set.toList xs)) ++ "}"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "{\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> (Set.toList xs)) ++ "\n" ++ indentation (ov - cv) indent ++ "}\n"
        
        
    instance (PrettyPrint a, Eq a) => PrettyPrint (WSet.Set a) where
        -- pprint 0 _ = "..."
        pprint v xs = "{" ++ intercalate "," (pprint (v) <$> (WSet.setToList xs)) ++ "}"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "{\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> (WSet.setToList xs)) ++ "\n" ++ indentation (ov - cv) indent ++ "}\n"
        
    instance (PrettyPrint a, Eq a, PrettyPrint b, Eq b) => PrettyPrint (WMap.Map a b) where
        -- pprint 0 _ = "..."
        pprint verbosity m = "{" ++ intercalate "," ((\(k,v) -> (pprint (verbosity) k) ++ "->" ++ (pprint (verbosity) v)) <$> (WMap.mapToList m)) ++ "}"
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "{\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> (WMap.mapToList xs)) ++ "\n" ++ indentation (ov - cv) indent ++ "}\n"
        
    instance PrettyPrint Bool where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n"
        
    instance PrettyPrint Char where
        -- pprint 0 = (const "...")
        pprint _ = (:[])
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ [x] ++ "\n"
        
    instance PrettyPrint Double where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Float where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Int where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Int8 where
        -- pprint 0 = (const "...")
        pprint _ = show  
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Int16 where
        -- pprint 0 = (const "...")
        pprint _ = show  
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Int32 where
        -- pprint 0 = (const "...")
        pprint _ = show  
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Int64 where
        -- pprint 0 = (const "...")
        pprint _ = show  
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Integer where
        -- pprint 0 = (const "...")
        pprint _ = show  
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    instance PrettyPrint Natural where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint Ordering where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint Word where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint Word8 where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint Word16 where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint Word32 where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint Word64 where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
            
    instance PrettyPrint () where
        -- pprint 0 = (const "...")
        pprint _ = show
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
               
    instance PrettyPrint Text.Text where
        -- pprint 0 = (const "...")
        pprint _ = Text.unpack
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
        
    
    -- | Pretty print a function on a specific domain.
    pprintFunction :: (PrettyPrint a, PrettyPrint b) =>
                   Int -> (a -> b) -> [a] -> String
    pprintFunction 0 _ _ = "..."
    pprintFunction v f xs = intercalate "\n" [pprint (v-1) x ++" -> " ++ pprint (v-1) (f x) | x <- xs]
    
    
    instance Simplifiable Text.Text where
        simplify = id