{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -fno-warn-orphans #-}
{-|
Module:      TextShow.Data.Containers
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances for data types in the @containers@ library.

/Since: 2/
-}
module TextShow.Data.Containers () where

import qualified Data.Foldable as F
import           Data.Graph (SCC)
import qualified Data.IntMap as IM
import           Data.IntMap (IntMap)
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.Map as M
import           Data.Map (Map)
import           Data.Sequence (Seq, ViewL, ViewR)
import qualified Data.Set as Set
import           Data.Set (Set)
import           Data.Tree (Tree)

import           TextShow (TextShow(..), TextShow1(..), TextShow2(..), showbPrec1)
import           TextShow.Data.Integral ()
import           TextShow.TH (deriveTextShow, deriveTextShow1)
import           TextShow.Utils (showbUnaryListWith)

-- | /Since: 2/
instance TextShow v => TextShow (IntMap v) where
    showbPrec :: Int -> IntMap v -> Builder
showbPrec = Int -> IntMap v -> Builder
forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow1 IntMap where
    liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> IntMap a -> Builder
liftShowbPrec Int -> a -> Builder
sp [a] -> Builder
_ Int
p =
        ([(Int, a)] -> Builder) -> Int -> [(Int, a)] -> Builder
forall a. ([a] -> Builder) -> Int -> [a] -> Builder
showbUnaryListWith ((Int -> Int -> Builder)
-> ([Int] -> Builder)
-> (Int -> a -> Builder)
-> ([a] -> Builder)
-> [(Int, a)]
-> Builder
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [f a b]
-> Builder
liftShowbList2 Int -> Int -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec      [Int] -> Builder
forall a. HasCallStack => a
undefined
                                           ((a -> Builder) -> Int -> a -> Builder
forall a b. a -> b -> a
const (Int -> a -> Builder
sp Int
0)) [a] -> Builder
forall a. HasCallStack => a
undefined) Int
p ([(Int, a)] -> Builder)
-> (IntMap a -> [(Int, a)]) -> IntMap a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList
    {-# INLINE liftShowbPrec #-}

-- | /Since: 2/
instance TextShow IntSet where
    showbPrec :: Int -> IntSet -> Builder
showbPrec Int
p = ([Int] -> Builder) -> Int -> [Int] -> Builder
forall a. ([a] -> Builder) -> Int -> [a] -> Builder
showbUnaryListWith [Int] -> Builder
forall a. TextShow a => [a] -> Builder
showbList Int
p ([Int] -> Builder) -> (IntSet -> [Int]) -> IntSet -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance (TextShow k, TextShow v) => TextShow (Map k v) where
    showbPrec :: Int -> Map k v -> Builder
showbPrec = Int -> Map k v -> Builder
forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow k => TextShow1 (Map k) where
    liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Map k a -> Builder
liftShowbPrec = (Int -> k -> Builder)
-> ([k] -> Builder)
-> (Int -> a -> Builder)
-> ([a] -> Builder)
-> Int
-> Map k a
-> Builder
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 Int -> k -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec [k] -> Builder
forall a. TextShow a => [a] -> Builder
showbList
    {-# INLINE liftShowbPrec #-}

-- | /Since: 2/
instance TextShow2 Map where
    liftShowbPrec2 :: (Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> Map a b
-> Builder
liftShowbPrec2 Int -> a -> Builder
sp1 [a] -> Builder
_ Int -> b -> Builder
sp2 [b] -> Builder
_ Int
p =
        ([(a, b)] -> Builder) -> Int -> [(a, b)] -> Builder
forall a. ([a] -> Builder) -> Int -> [a] -> Builder
showbUnaryListWith ((Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [(a, b)]
-> Builder
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [f a b]
-> Builder
liftShowbList2 ((a -> Builder) -> Int -> a -> Builder
forall a b. a -> b -> a
const (Int -> a -> Builder
sp1 Int
0)) [a] -> Builder
forall a. HasCallStack => a
undefined
                                           ((b -> Builder) -> Int -> b -> Builder
forall a b. a -> b -> a
const (Int -> b -> Builder
sp2 Int
0)) [b] -> Builder
forall a. HasCallStack => a
undefined) Int
p ([(a, b)] -> Builder)
-> (Map a b -> [(a, b)]) -> Map a b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList
    {-# INLINE liftShowbPrec2 #-}

-- | /Since: 2/
instance TextShow a => TextShow (Seq a) where
    showbPrec :: Int -> Seq a -> Builder
showbPrec = Int -> Seq a -> Builder
forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow1 Seq where
    liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Seq a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
sl Int
p = ([a] -> Builder) -> Int -> [a] -> Builder
forall a. ([a] -> Builder) -> Int -> [a] -> Builder
showbUnaryListWith [a] -> Builder
sl Int
p ([a] -> Builder) -> (Seq a -> [a]) -> Seq a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
    {-# INLINE liftShowbPrec #-}

-- | /Since: 2/
$(deriveTextShow  ''ViewL)
-- | /Since: 2/
$(deriveTextShow1 ''ViewL)

-- | /Since: 2/
$(deriveTextShow  ''ViewR)
-- | /Since: 2/
$(deriveTextShow1 ''ViewR)

-- | /Since: 2/
instance TextShow a => TextShow (Set a) where
    showbPrec :: Int -> Set a -> Builder
showbPrec = Int -> Set a -> Builder
forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow1 Set where
    liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Set a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
sl Int
p = ([a] -> Builder) -> Int -> [a] -> Builder
forall a. ([a] -> Builder) -> Int -> [a] -> Builder
showbUnaryListWith [a] -> Builder
sl Int
p ([a] -> Builder) -> (Set a -> [a]) -> Set a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
    {-# INLINE liftShowbPrec #-}

-- | /Since: 3.6/
$(deriveTextShow  ''SCC)
-- | /Since: 3.6/
$(deriveTextShow1 ''SCC)

-- | /Since: 2/
$(deriveTextShow  ''Tree)
-- | /Since: 2/
$(deriveTextShow1 ''Tree)