{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module HaskellWorks.Data.MQuery.Micro where

import Text.PrettyPrint.ANSI.Leijen

import qualified Data.DList as DL

newtype Micro a = Micro a

prettyVs :: Pretty a => [a] -> Doc
prettyVs :: [a] -> Doc
prettyVs (a
kv:[a]
kvs) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
kv Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) Doc
empty ((\a
jv -> String -> Doc
text String
", " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
jv) (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
`map` [a]
kvs)
prettyVs []       = Doc
empty

putPretty :: Pretty a => a -> IO ()
putPretty :: a -> IO ()
putPretty a
a = Doc -> IO ()
putDoc (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline)

prettyKvs :: Pretty (Micro a) => [a] -> Doc
prettyKvs :: [a] -> Doc
prettyKvs (a
kv:[a]
kvs) = Micro a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> Micro a
forall a. a -> Micro a
Micro a
kv) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) Doc
empty ((\a
jv -> String -> Doc
text String
", " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Micro a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> Micro a
forall a. a -> Micro a
Micro a
jv)) (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
`map` [a]
kvs)
prettyKvs []       = Doc
empty

instance Pretty a => Pretty (Micro [a]) where
  pretty :: Micro [a] -> Doc
pretty (Micro [a]
xs) = case [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs of
    Int
xsLen | Int
xsLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  -> String -> Doc
text String
"[]"
    Int
xsLen | Int
xsLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 -> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs [a]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
    Int
_                   -> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
10 [a]
xs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..]"

instance Pretty a => Pretty (Micro (DL.DList a)) where
  pretty :: Micro (DList a) -> Doc
pretty (Micro DList a
dxs) = case DList a -> [a]
forall a. DList a -> [a]
DL.toList DList a
dxs of
    xs :: [a]
xs@(a
_:a
_:a
_:a
_:a
_:a
_:a
_:a
_:a
_:a
_:a
_:a
_:[a]
_) -> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
50 [a]
xs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..]"
    []                             -> String -> Doc
text String
"[]"
    [a]
xs                             -> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs          [a]
xs  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"