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