diff --git a/hw-xml.cabal b/hw-xml.cabal --- a/hw-xml.cabal +++ b/hw-xml.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-xml -version: 0.5.1.1 +version: 0.5.1.2 synopsis: XML parser based on succinct data structures. description: XML parser based on succinct data structures. Please see README.md category: Data, XML, Succinct Data Structures, Data Structures @@ -25,20 +25,20 @@ common base { build-depends: base >= 4.11 && < 5 } -common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.9 && < 0.7 } +common prettyprinter { build-depends: prettyprinter >= 0.6.9 && < 2 } common array { build-depends: array >= 0.5.2.0 && < 0.6 } common attoparsec { build-depends: attoparsec >= 0.13.2.2 && < 0.15 } -common bytestring { build-depends: bytestring >= 0.10.8.2 && < 0.12 } +common bytestring { build-depends: bytestring >= 0.10.8.2 && < 0.13 } common cereal { build-depends: cereal >= 0.5.8.1 && < 0.6 } -common containers { build-depends: containers >= 0.5.10.2 && < 0.7 } -common criterion { build-depends: criterion >= 1.5.5.0 && < 1.6 } -common deepseq { build-depends: deepseq >= 1.4.3.0 && < 1.5 } -common doctest { build-depends: doctest >= 0.16.2 && < 0.21 } +common containers { build-depends: containers >= 0.5.10.2 && < 0.8 } +common criterion { build-depends: criterion >= 1.5.5.0 && < 1.7 } +common deepseq { build-depends: deepseq >= 1.4.3.0 && < 1.6 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.23 } common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } common generic-lens { build-depends: generic-lens >= 2.2 && < 2.3 } -common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.9 } -common hedgehog { build-depends: hedgehog >= 1.0 && < 1.2 } -common hspec { build-depends: hspec >= 2.5 && < 3.0 } +common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.12 } +common hedgehog { build-depends: hedgehog >= 1.0 && < 1.5 } +common hspec { build-depends: hspec >= 2.5 && < 3 } common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.1 && < 0.5 } common hw-bits { build-depends: hw-bits >= 0.7.0.9 && < 0.8 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } @@ -49,11 +49,11 @@ common lens { build-depends: lens >= 4.17.1 && < 6 } common mmap { build-depends: mmap >= 0.5.9 && < 0.6 } common mtl { build-depends: mtl >= 2.2.2 && < 3 } -common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 && < 0.18 } -common resourcet { build-depends: resourcet >= 1.2.2 && < 1.3 } -common text { build-depends: text >= 1.2.3.2 && < 1.3 } +common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 && < 0.19 } +common resourcet { build-depends: resourcet >= 1.2.2 && < 2 } +common text { build-depends: text >= 1.2.3.2 && < 3 } common transformers { build-depends: transformers >= 0.5 && < 0.7 } -common vector { build-depends: vector >= 0.12.0.3 && < 0.13 } +common vector { build-depends: vector >= 0.12.0.3 && < 0.14 } common word8 { build-depends: word8 >= 0.1.3 && < 0.2 } common config @@ -64,7 +64,6 @@ library import: base, config - , ansi-wl-pprint , array , attoparsec , base @@ -82,6 +81,7 @@ , lens , mmap , mtl + , prettyprinter , resourcet , text , transformers diff --git a/src/HaskellWorks/Data/Xml/RawValue.hs b/src/HaskellWorks/Data/Xml/RawValue.hs --- a/src/HaskellWorks/Data/Xml/RawValue.hs +++ b/src/HaskellWorks/Data/Xml/RawValue.hs @@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module HaskellWorks.Data.Xml.RawValue ( RawValue(..) @@ -15,7 +16,7 @@ import HaskellWorks.Data.Xml.Grammar import HaskellWorks.Data.Xml.Internal.Show import HaskellWorks.Data.Xml.Succinct.Index -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) +import Prettyprinter import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString as BS @@ -34,35 +35,49 @@ | RawError Text deriving (Eq, Show) +-- TODO use colors and styles + +red :: Doc ann -> Doc ann +red = id + +dullwhite :: Doc ann -> Doc ann +dullwhite = id + +bold :: Doc ann -> Doc ann +bold = id + +dullgreen :: Doc ann -> Doc ann +dullgreen = id + instance Pretty RawValue where pretty mjpv = case mjpv of - RawText s -> ctext $ text (T.unpack s) - RawAttrName s -> text (T.unpack s) - RawAttrValue s -> (ctext . dquotes . text) (T.unpack s) + RawText s -> ctext $ pretty (T.unpack s) + RawAttrName s -> pretty (T.unpack s) + RawAttrValue s -> (ctext . dquotes . pretty) (T.unpack s) RawAttrList ats -> formatAttrs ats - RawComment s -> text $ "" + RawComment s -> pretty $ "" RawElement s xs -> formatElem (T.unpack s) xs RawDocument xs -> formatMeta "?" "xml" xs - RawError s -> red $ text "[error " <> text (T.unpack s) <> text "]" - RawCData s -> cangle " ctag (text "[CDATA[") <> text (T.unpack s) <> cangle (text "]]>") + RawError s -> red $ "[error " <> pretty (T.unpack s) <> "]" + RawCData s -> cangle " ctag "[CDATA[" <> pretty (T.unpack s) <> cangle "]]>" RawMeta s xs -> formatMeta "!" (T.unpack s) xs where formatAttr at = case at of - RawAttrName a -> text " " <> pretty (RawAttrName a) - RawAttrValue a -> text "=" <> pretty (RawAttrValue a) - RawAttrList _ -> red $ text "ATTRS" - _ -> red $ text "booo" + RawAttrName a -> " " <> pretty (RawAttrName a) + RawAttrValue a -> "=" <> pretty (RawAttrValue a) + RawAttrList _ -> red "ATTRS" + _ -> red "booo" formatAttrs ats = hcat (formatAttr <$> ats) formatElem s xs = let (ats, es) = partition isAttrL xs - in cangle langle <> ctag (text s) + in cangle langle <> ctag (pretty s) <> hcat (pretty <$> ats) <> cangle rangle <> hcat (pretty <$> es) - <> cangle (text " ctag (text s) <> cangle rangle + <> cangle " ctag (pretty s) <> cangle rangle formatMeta b s xs = let (ats, es) = partition isAttr xs - in cangle (langle <> text b) <> ctag (text s) + in cangle (langle <> pretty @String b) <> ctag (pretty @String s) <> hcat (pretty <$> ats) <> cangle rangle <> hcat (pretty <$> es) @@ -102,13 +117,13 @@ ABC.Partial _ -> decodeErr "Unexpected end of attr name, expected" bs ABC.Done _ r -> Right r -cangle :: Doc -> Doc +cangle :: Doc ann -> Doc ann cangle = dullwhite -ctag :: Doc -> Doc +ctag :: Doc ann -> Doc ann ctag = bold -ctext :: Doc -> Doc +ctext :: Doc ann -> Doc ann ctext = dullgreen isAttrL :: RawValue -> Bool