diff --git a/hw-mquery.cabal b/hw-mquery.cabal --- a/hw-mquery.cabal +++ b/hw-mquery.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-mquery -version: 0.2.1.1 +version: 0.2.1.2 synopsis: Monadic query DSL description: Please see README.md category: Data @@ -22,11 +22,11 @@ common base { build-depends: base >= 4.11 && < 5 } -common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.8 && < 0.7 } +common prettyprinter { build-depends: prettyprinter >= 1 && < 2 } common dlist { build-depends: dlist >= 0.8.0 && < 1.1 } -common doctest { build-depends: doctest >= 0.16.2 && < 0.21 } +common doctest { build-depends: doctest >= 0.16.2 && < 1 } common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } -common hedgehog { build-depends: hedgehog >= 0.6.1 && < 1.2 } +common hedgehog { build-depends: hedgehog >= 0.6.1 && < 2 } common hspec { build-depends: hspec >= 2.6.0 && < 3 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.5 && < 0.2 } common lens { build-depends: lens >= 4.17 && < 6 } @@ -40,7 +40,7 @@ library import: base, config - , ansi-wl-pprint + , prettyprinter , dlist , lens hs-source-dirs: src diff --git a/src/HaskellWorks/Data/MQuery.hs b/src/HaskellWorks/Data/MQuery.hs --- a/src/HaskellWorks/Data/MQuery.hs +++ b/src/HaskellWorks/Data/MQuery.hs @@ -13,7 +13,7 @@ import HaskellWorks.Data.MQuery.Entry import HaskellWorks.Data.MQuery.Row import HaskellWorks.Data.MQuery.ToBool -import Text.PrettyPrint.ANSI.Leijen hiding ((<>)) +import Prettyprinter import qualified Data.DList as DL diff --git a/src/HaskellWorks/Data/MQuery/Entry.hs b/src/HaskellWorks/Data/MQuery/Entry.hs --- a/src/HaskellWorks/Data/MQuery/Entry.hs +++ b/src/HaskellWorks/Data/MQuery/Entry.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} + module HaskellWorks.Data.MQuery.Entry where -import Text.PrettyPrint.ANSI.Leijen +import Prettyprinter data Entry k v = Entry k v instance (Pretty k, Pretty v) => Pretty (Entry k v) where - pretty (Entry k v) = pretty k <> text ": " <> pretty v + pretty (Entry k v) = pretty k <> ": " <> pretty v diff --git a/src/HaskellWorks/Data/MQuery/Micro.hs b/src/HaskellWorks/Data/MQuery/Micro.hs --- a/src/HaskellWorks/Data/MQuery/Micro.hs +++ b/src/HaskellWorks/Data/MQuery/Micro.hs @@ -1,34 +1,37 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} module HaskellWorks.Data.MQuery.Micro where -import Text.PrettyPrint.ANSI.Leijen +import Prettyprinter +import Prettyprinter.Render.Text + import qualified Data.DList as DL newtype Micro a = Micro a -prettyVs :: Pretty a => [a] -> Doc -prettyVs (kv:kvs) = pretty kv <> foldl (<>) empty ((\jv -> text ", " <> pretty jv) `map` kvs) -prettyVs [] = empty +prettyVs :: Pretty a => [a] -> Doc ann +prettyVs (kv:kvs) = pretty kv <> foldl (<>) mempty ((\jv -> ", " <> pretty jv) `map` kvs) +prettyVs [] = mempty putPretty :: Pretty a => a -> IO () putPretty a = putDoc (pretty a <> hardline) -prettyKvs :: Pretty (Micro a) => [a] -> Doc -prettyKvs (kv:kvs) = pretty (Micro kv) <> foldl (<>) empty ((\jv -> text ", " <> pretty (Micro jv)) `map` kvs) -prettyKvs [] = empty +prettyKvs :: Pretty (Micro a) => [a] -> Doc ann +prettyKvs (kv:kvs) = pretty (Micro kv) <> foldl (<>) mempty ((\jv -> ", " <> pretty (Micro jv)) `map` kvs) +prettyKvs [] = mempty instance Pretty a => Pretty (Micro [a]) where pretty (Micro xs) = case length xs of - xsLen | xsLen == 0 -> text "[]" - xsLen | xsLen <= 10 -> text "[" <> prettyVs xs <> text "]" - _ -> text "[" <> prettyVs (take 10 xs) <> text ", ..]" + xsLen | xsLen == 0 -> "[]" + xsLen | xsLen <= 10 -> "[" <> prettyVs xs <> "]" + _ -> "[" <> prettyVs (take 10 xs) <> ", ..]" instance Pretty a => Pretty (Micro (DL.DList a)) where pretty (Micro dxs) = case DL.toList dxs of - xs@(_:_:_:_:_:_:_:_:_:_:_:_:_) -> text "[" <> prettyVs (take 50 xs) <> text ", ..]" - [] -> text "[]" - xs -> text "[" <> prettyVs xs <> text "]" + xs@(_:_:_:_:_:_:_:_:_:_:_:_:_) -> "[" <> prettyVs (take 50 xs) <> ", ..]" + [] -> "[]" + xs -> "[" <> prettyVs xs <> "]" diff --git a/src/HaskellWorks/Data/MQuery/Mini.hs b/src/HaskellWorks/Data/MQuery/Mini.hs --- a/src/HaskellWorks/Data/MQuery/Mini.hs +++ b/src/HaskellWorks/Data/MQuery/Mini.hs @@ -1,20 +1,21 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} module HaskellWorks.Data.MQuery.Mini where import HaskellWorks.Data.MQuery.AtLeastSize import HaskellWorks.Data.MQuery.Micro -import Text.PrettyPrint.ANSI.Leijen +import Prettyprinter import qualified Data.DList as DL newtype Mini a = Mini a instance Pretty (Micro a) => Pretty (Mini [a]) where - pretty (Mini xs) | xs `atLeastSize` 11 = text "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> text ", ..]" - pretty (Mini xs) | xs `atLeastSize` 1 = text "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> text "]" - pretty (Mini _ ) = text "[]" + pretty (Mini xs) | xs `atLeastSize` 11 = "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> ", ..]" + pretty (Mini xs) | xs `atLeastSize` 1 = "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> "]" + pretty (Mini _ ) = "[]" instance Pretty (Mini a) => Pretty (Mini (DL.DList a)) where - pretty (Mini xs) = vcat (punctuate (text ",") ((pretty . Mini) `map` take 10 (DL.toList xs))) + pretty (Mini xs) = vcat (punctuate "," ((pretty . Mini) `map` take 10 (DL.toList xs))) diff --git a/src/HaskellWorks/Data/MQuery/Row.hs b/src/HaskellWorks/Data/MQuery/Row.hs --- a/src/HaskellWorks/Data/MQuery/Row.hs +++ b/src/HaskellWorks/Data/MQuery/Row.hs @@ -1,9 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} module HaskellWorks.Data.MQuery.Row where -import Text.PrettyPrint.ANSI.Leijen +import Prettyprinter import qualified Data.DList as DL @@ -12,11 +13,12 @@ data Row a = Row MaxChars a instance Pretty a => Pretty (Row (DL.DList a)) where - pretty (Row maxChars xs) = vcat (((bold . yellow) (text "==> ") <>) `map` prettyRows) - where prettyRows :: [Doc] - prettyRows = (\row -> text (take maxChars (displayS (renderCompact (pretty row)) []))) `map` DL.toList xs + -- TODO implement max chars for Row + pretty (Row _ xs) = vcat (("==> " <>) `map` prettyRows) + where prettyRows :: [Doc ann] + prettyRows = fmap pretty $ DL.toList xs -prettyRowOfString :: Show a => Row (DL.DList a) -> Doc -prettyRowOfString (Row _ xs) = vcat (((bold . yellow) (text "==> ") <>) `map` prettyRows) - where prettyRows :: [Doc] - prettyRows = (text . show) `map` DL.toList xs +prettyRowOfString :: Show a => Row (DL.DList a) -> Doc ann +prettyRowOfString (Row _ xs) = vcat (("==> " <>) `map` prettyRows) + where prettyRows :: [Doc ann] + prettyRows = (pretty . show) `map` DL.toList xs