add --compact switch to the pretty-simple executable (cdepillabout#34)

juhp · Jun 5, 2022 · a367056 · a367056
1 parent da22de6
commit a367056
Showing 1 changed file with 20 additions and 9 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -29,22 +29,25 @@ import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy.IO as LT
 import Data.Version (showVersion)
 import Options.Applicative
-       ( Parser, ReadM, execParser, fullDesc, help, helper, info, infoOption, long
-       , option, progDesc, readerError, short, showDefaultWith, str, value)
+       ( Parser, ReadM, execParser, fullDesc, help, helper, info, infoOption
+       , long, option, progDesc, readerError, short, showDefaultWith, str
+       , switch, value)
 import Paths_pretty_simple (version)
 import Text.Pretty.Simple
        ( pStringOpt, OutputOptions
        , defaultOutputOptionsDarkBg
        , defaultOutputOptionsLightBg
        , defaultOutputOptionsNoColor
+       , outputOptionsCompact
        )
 
 data Color = DarkBg
            | LightBg
            | NoColor
 
-newtype Args = Args
+data Args = Args
   { color :: Color
+  , compact :: Bool
   }
 
 colorReader :: ReadM Color
@@ -65,6 +68,11 @@ args = Args
        <> showDefaultWith (const "dark-bg")
        <> value DarkBg
         )
+    <*> switch
+        ( long "compact"
+       <> short 'C'
+       <> help "Compact output"
+        )
 
 versionOption :: Parser (a -> a)
 versionOption =
@@ -79,16 +87,19 @@ main :: IO ()
 main = do
   args' <- execParser opts
   input <- T.getContents
-  let printOpt = getPrintOpt $ color args'
-      output = pStringOpt printOpt $ unpack input
+  let output = pStringOpt (getPrintOpt args') $ unpack input
   LT.putStrLn output
   where
     opts = info (helper <*> versionOption <*> args)
       ( fullDesc
      <> progDesc "Format Haskell data types with indentation and highlighting"
       )
 
-    getPrintOpt :: Color -> OutputOptions
-    getPrintOpt DarkBg  = defaultOutputOptionsDarkBg
-    getPrintOpt LightBg = defaultOutputOptionsLightBg
-    getPrintOpt NoColor = defaultOutputOptionsNoColor
+    getPrintOpt :: Args -> OutputOptions
+    getPrintOpt as =
+      (getColorOpt (color as)) {outputOptionsCompact = compact as}
+
+    getColorOpt :: Color -> OutputOptions
+    getColorOpt DarkBg  = defaultOutputOptionsDarkBg
+    getColorOpt LightBg = defaultOutputOptionsLightBg
+    getColorOpt NoColor = defaultOutputOptionsNoColor