Undo annotations

Author: newhoggy

optparse-applicative.cabal

@@ -87,7 +87,6 @@ library
                      , Options.Applicative.Common
                      , Options.Applicative.Extra
                      , Options.Applicative.Help
-                     , Options.Applicative.Help.Ann
                      , Options.Applicative.Help.Chunk
                      , Options.Applicative.Help.Core
                      , Options.Applicative.Help.Levenshtein

src/Options/Applicative/Help/Ann.hs

@@ -24,17 +24,13 @@ import Data.Maybe
 import Data.Semigroup
 import Prelude
 
-import Options.Applicative.Help.Ann
 import Options.Applicative.Help.Pretty
 
 -- | The free monoid on a semigroup 'a'.
 newtype Chunk a = Chunk
   { unChunk :: Maybe a }
   deriving (Eq, Show)
 
-instance CanAnnotate (Chunk Doc) where
-  annTrace n = fmap . annTrace n
-
 instance Functor Chunk where
   fmap f = Chunk . fmap f . unChunk
 
@@ -97,20 +93,20 @@ extractChunk = fromMaybe mempty . unChunk
 -- Unlike '<+>' for 'Doc', this operation has a unit element, namely the empty
 -- 'Chunk'.
 (<<+>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc
-(<<+>>) = fmap (annTrace 1 "(<<+>>)") . chunked (<+>)
+(<<+>>) = chunked (<+>)
 
 -- | Concatenate two 'Chunk's with a softline in between.  This is exactly like
 -- '<<+>>', but uses a softline instead of a space.
 (<</>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc
-(<</>>) = fmap (annTrace 1 "(<</>>)") . chunked (</>)
+(<</>>) = chunked (</>)
 
 -- | Concatenate 'Chunk's vertically.
 vcatChunks :: [Chunk Doc] -> Chunk Doc
-vcatChunks = fmap (annTrace 1 "vcatChunks") . foldr (chunked (.$.)) mempty
+vcatChunks = foldr (chunked (.$.)) mempty
 
 -- | Concatenate 'Chunk's vertically separated by empty lines.
 vsepChunks :: [Chunk Doc] -> Chunk Doc
-vsepChunks = annTrace 1 "vsepChunks" . foldr (chunked (\x y -> x .$. mempty .$. y)) mempty
+vsepChunks = foldr (chunked (\x y -> x .$. mempty .$. y)) mempty
 
 -- | Whether a 'Chunk' is empty.  Note that something like 'pure mempty' is not
 -- considered an empty chunk, even though the underlying 'Doc' is empty.
@@ -122,8 +118,8 @@ isEmpty = isNothing . unChunk
 -- > isEmpty . stringChunk = null
 -- > extractChunk . stringChunk = string
 stringChunk :: String -> Chunk Doc
-stringChunk "" = annTrace 0 "stringChunk" mempty
-stringChunk s = annTrace 0 "stringChunk" $ pure (string s)
+stringChunk "" = mempty
+stringChunk s = pure (string s)
 
 -- | Convert a paragraph into a 'Chunk'.  The resulting chunk is composed by the
 -- words of the original paragraph separated by softlines, so it will be
@@ -133,14 +129,12 @@ stringChunk s = annTrace 0 "stringChunk" $ pure (string s)
 --
 -- > isEmpty . paragraph = null . words
 paragraph :: String -> Chunk Doc
-paragraph = annTrace 0 "paragraph"
-  . foldr (chunked (</>) . stringChunk) mempty
-  . words
+paragraph = foldr (chunked (</>) . stringChunk) mempty . words
 
 -- | Display pairs of strings in a table.
 tabulate :: Int -> [(Doc, Doc)] -> Chunk Doc
-tabulate _ [] = annTrace 1 "tabulate" mempty
-tabulate size table = annTrace 1 "tabulate" . pure $ vcat
+tabulate _ [] = mempty
+tabulate size table = pure $ vcat
   [ indent 2 (fillBreak size key <+> value)
   | (key, value) <- table ]
 

src/Options/Applicative/Help/Chunk.hs

@@ -36,7 +36,6 @@ import Prelude hiding (any)
 
 import Options.Applicative.Common
 import Options.Applicative.Types
-import Options.Applicative.Help.Ann
 import Options.Applicative.Help.Chunk
 import Options.Applicative.Help.Pretty
 
@@ -57,7 +56,7 @@ safelast = foldl' (const Just) Nothing
 
 -- | Generate description for a single option.
 optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Chunk Doc, Parenthetic)
-optDesc pprefs style _reachability opt = first (annTrace 2 "optDesc") $
+optDesc pprefs style _reachability opt =
   let names =
         sort . optionNames . optMain $ opt
       meta =
@@ -96,7 +95,7 @@ optDesc pprefs style _reachability opt = first (annTrace 2 "optDesc") $
 
 -- | Generate descriptions for commands.
 cmdDesc :: ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)]
-cmdDesc pprefs = fmap (fmap (annTrace 2 "cmdDesc")) <$> mapParser desc
+cmdDesc pprefs = mapParser desc
   where
     desc _ opt =
       case optMain opt of
@@ -111,18 +110,18 @@ cmdDesc pprefs = fmap (fmap (annTrace 2 "cmdDesc")) <$> mapParser desc
 
 -- | Generate a brief help text for a parser.
 briefDesc :: ParserPrefs -> Parser a -> Chunk Doc
-briefDesc = fmap (annTrace 2 "briefDesc") . briefDesc' True
+briefDesc = briefDesc' True
 
 -- | Generate a brief help text for a parser, only including mandatory
 --   options and arguments.
 missingDesc :: ParserPrefs -> Parser a -> Chunk Doc
-missingDesc = fmap (annTrace 2 "missingDesc") . briefDesc' False
+missingDesc = briefDesc' False
 
 -- | Generate a brief help text for a parser, allowing the specification
 --   of if optional arguments are show.
 briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
-briefDesc' showOptional pprefs = fmap (annTrace 2 "briefDesc'")
-    . wrapOver NoDefault MaybeRequired
+briefDesc' showOptional pprefs =
+  wrapOver NoDefault MaybeRequired
     . foldTree pprefs style
     . mfilterOptional
     . treeMapParser (optDesc pprefs style)
@@ -142,18 +141,17 @@ briefDesc' showOptional pprefs = fmap (annTrace 2 "briefDesc'")
 wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
 wrapOver altnode mustWrapBeyond (chunk, wrapping)
   | chunkIsEffectivelyEmpty chunk =
-    annTrace 3 "wrapOver0" <$> chunk
+      chunk
   | altnode == MarkDefault =
-    annTrace 3 "wrapOver1" <$> fmap brackets chunk
+      fmap brackets chunk
   | wrapping > mustWrapBeyond =
-    annTrace 3 "wrapOver2" <$> fmap parens chunk
-  | otherwise =
-    annTrace 3 "wrapOver3" chunk
+      fmap parens chunk
+  | otherwise = chunk
 
 -- Fold a tree of option docs into a single doc with fully marked
 -- optional areas and groups.
 foldTree :: ParserPrefs -> OptDescStyle -> OptTree (Chunk Doc, Parenthetic) -> (Chunk Doc, Parenthetic)
-foldTree _ _ (Leaf x) = first (annTrace 3 "foldTree1")
+foldTree _ _ (Leaf x) =
   x
 foldTree prefs s (MultNode xs) =
   ( let generous :: Chunk Doc
@@ -179,7 +177,7 @@ foldTree prefs s (MultNode xs) =
     leads :: [Chunk Doc]
     leads = fmap pure (pretty " ":repeat (line <> pretty "  "))
 
-foldTree prefs s (AltNode b xs) = first (annTrace 3 "foldTree2") $
+foldTree prefs s (AltNode b xs) =
   (\x -> (x, NeverRequired))
     . fmap groupOrNestLine
     . wrapOver b MaybeRequired
@@ -211,7 +209,7 @@ foldTree prefs s (AltNode b xs) = first (annTrace 3 "foldTree2") $
     leads :: [Chunk Doc]
     leads = fmap pure (pretty " ":repeat (line <> pretty "| "))
 
-foldTree prefs s (BindNode x) = first (annTrace 3 "foldTree3") $
+foldTree prefs s (BindNode x) =
   let rendered =
         wrapOver NoDefault NeverRequired (foldTree prefs s x)
 
@@ -223,21 +221,17 @@ foldTree prefs s (BindNode x) = first (annTrace 3 "foldTree3") $
 
 -- | Generate a full help text for a parser
 fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
-fullDesc = fmap (annTrace 2 "fullDesc") <$> optionsDesc False
+fullDesc = optionsDesc False
 
 -- | Generate a help text for the parser, showing
 --   only what is relevant in the "Global options: section"
 globalDesc :: ParserPrefs -> Parser a -> Chunk Doc
-globalDesc = fmap (annTrace 2 "globalDesc") <$> optionsDesc True
+globalDesc = optionsDesc True
 
 -- | Common generator for full descriptions and globals
 optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
-optionsDesc global pprefs = fmap (annTrace 2 "optionsDesc")
-    . tabulate (prefTabulateFill pprefs)
-    . catMaybes
-    . mapParser doc
+optionsDesc global pprefs = tabulate (prefTabulateFill pprefs) . catMaybes . mapParser doc
   where
-    doc :: MonadPlus m => ArgumentReachability -> Option a -> m (Doc, Doc)
     doc info opt = do
       guard . not . isEmpty $ n
       guard . not . isEmpty $ h
@@ -292,7 +286,7 @@ parserHelp pprefs p =
         vcatChunks (snd <$> a)
     group_title _ = mempty
 
-    with_title title = annTrace 1 "with_title" . fmap (string title .$.)
+    with_title title = fmap (string title .$.)
 
 
 parserGlobals :: ParserPrefs -> Parser a -> ParserHelp
@@ -305,7 +299,7 @@ parserGlobals pprefs p =
 
 -- | Generate option summary.
 parserUsage :: ParserPrefs -> Parser a -> String -> Doc
-parserUsage pprefs p progn = annTrace 2 "parserUsage" $
+parserUsage pprefs p progn =
   case prefUsageOverflow pprefs of
     UsageOverflowAlign ->
       hsep

src/Options/Applicative/Help/Core.hs

@@ -5,16 +5,8 @@ module Options.Applicative.Help.Pretty
   , (.$.)
   , groupOrNestLine
   , altSep
-  , Ann(..)
   , Doc
 
-  , enclose
-  , parens
-  , brackets
-  , hang
-  , indent
-  , nest
-
   -- TODO Remove these
   -- , (<$>)
   , (</>)
@@ -32,23 +24,22 @@ import           Control.Applicative
 import           Data.Semigroup ((<>))
 #endif
 
-import           Options.Applicative.Help.Ann
-import           Prettyprinter hiding ((<>), Doc, enclose, parens, brackets, hang, indent, nest)
+import           Prettyprinter hiding ((<>), Doc)
 import qualified Prettyprinter as PP
 import qualified Prettyprinter.Internal as PPI
 import           Prettyprinter.Render.String (renderShowS)
 
 import           Prelude
 
-type Doc = PPI.Doc Ann
+type Doc = PPI.Doc ()
 
 (.$.) :: Doc -> Doc -> Doc
-(.$.) x y = annTrace 1 "(.$.)" (x <> line <> y)
+(.$.) x y = x <> line <> y
 
 -- | Apply the function if we're not at the
 --   start of our nesting level.
 ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc
-ifNotAtRoot f doc = annTrace 1 "ifNotAtRoot" $
+ifNotAtRoot f doc =
   PPI.Nesting $ \i ->
     PPI.Column $ \j ->
       if i == j
@@ -62,10 +53,10 @@ ifNotAtRoot f doc = annTrace 1 "ifNotAtRoot" $
 --   This will also nest subsequent lines in the
 --   group.
 groupOrNestLine :: Doc -> Doc
-groupOrNestLine d = annTrace 1 "groupOrNestLine" $
-  (PPI.Union
+groupOrNestLine =
+  PPI.Union
     <$> flatten
-    <*> ifNotAtRoot (line <>)) d
+    <*> ifNotAtRoot (line <>)
   where flatten :: Doc -> Doc
         flatten doc = case doc of
           PPI.FlatAlt _ y     -> flatten y
@@ -94,59 +85,35 @@ groupOrNestLine d = annTrace 1 "groupOrNestLine" $
 --   but it's possible for y to still appear on the
 --   next line.
 altSep :: Doc -> Doc -> Doc
-altSep x y = annTrace 1 "altSep" $
+altSep x y =
   group (x <+> pretty "|" <> line) <> softline' <> y
 
-
--- (<$>) :: Doc -> Doc -> Doc
--- (<$>) = \x y -> x <> line <> y
-
 (</>) :: Doc -> Doc -> Doc
-(</>) x y = annTrace 1 "(</>)" $ x <> softline <> y
+(</>) x y = x <> softline <> y
 
 (<$$>) :: Doc -> Doc -> Doc
-(<$$>) x y = annTrace 1 "(<$$>)" $x <> linebreak <> y
+(<$$>) x y = x <> linebreak <> y
 
 (<//>) :: Doc -> Doc -> Doc
-(<//>) x y = annTrace 1 "(<//>)" $ x <> softbreak <> y
+(<//>) x y = x <> softbreak <> y
 
 linebreak :: Doc
-linebreak = annTrace 0 "linebreak" $ flatAlt line mempty
+linebreak = flatAlt line mempty
 
 softbreak :: Doc
-softbreak = annTrace 0 "softbreak" $ group linebreak
+softbreak = group linebreak
 
 -- | Traced version of 'PP.string'.
 string :: String -> Doc
-string = annTrace 0 "string" . PP.pretty
+string = PP.pretty
 
 -- | Traced version of 'PP.parens'.
 parens :: Doc -> Doc
-parens = annTrace 1 "parens" . PP.parens
+parens = PP.parens
 
 -- | Traced version of 'PP.brackets'.
 brackets :: Doc -> Doc
-brackets = annTrace 1 "brackets" . PP.brackets
-
--- | Traced version of 'PP.enclose'.
-enclose
-    :: Doc -- ^ L
-    -> Doc -- ^ R
-    -> Doc -- ^ x
-    -> Doc -- ^ LxR
-enclose l r x = annTrace 1 "enclose" (PP.enclose l r x)
-
--- | Traced version of 'PP.hang'.
-hang :: Int -> Doc -> Doc
-hang n = annTrace 1 "hang" . PP.hang n
-
--- | Traced version of 'PP.nest'.
-nest :: Int -> Doc -> Doc
-nest n = annTrace 1 "nest" . PP.nest n
-
--- | Traced version of 'PP.indent'.
-indent :: Int -> Doc -> Doc
-indent n = annTrace 1 "indent" . PP.indent n
+brackets = PP.brackets
 
 -- | Determine if the document is empty when rendered
 isEffectivelyEmpty :: Doc -> Bool