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

module HaskellWorks.Data.MQuery.Micro where

import Prettyprinter
import Prettyprinter.Render.Text


import qualified Data.DList as DL

newtype Micro a = Micro a

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

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

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

instance Pretty a => Pretty (Micro [a]) where
  pretty :: forall ann. Micro [a] -> Doc ann
pretty (Micro [a]
xs) = case [a] -> Int
forall a. [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  -> Doc ann
"[]"
    Int
xsLen | Int
xsLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 -> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyVs [a]
xs Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
    Int
_                   -> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyVs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
10 [a]
xs) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", ..]"

instance Pretty a => Pretty (Micro (DL.DList a)) where
  pretty :: forall ann. Micro (DList a) -> Doc ann
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]
_) -> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyVs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
50 [a]
xs) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", ..]"
    []                             -> Doc ann
"[]"
    [a]
xs                             -> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyVs          [a]
xs  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"