{-# 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 "]"