hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Allow to control prettiness of JSON output

Browse Source
This commit is contained in:
Julian Ospald 2020-04-13 15:25:50 +02:00
parent 28a1077833
commit d888d11d59
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 20 additions and 2179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
app/ghcup-gen/Main.hs
View File

@ -1,10 +1,11 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Main where module Main where
@ -14,7 +15,7 @@ import GHCup.Types.JSON ( )
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCupInfo import GHCupInfo
import Data.Aeson ( eitherDecode ) import Data.Aeson ( eitherDecode, encode )
import Data.Aeson.Encode.Pretty import Data.Aeson.Encode.Pretty
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) ) import Data.Semigroup ( (<>) )
@ -61,10 +62,13 @@ outputP = fileOutput <|> stdOutput
data GenJSONOpts = GenJSONOpts data GenJSONOpts = GenJSONOpts
{ output :: Maybe Output { output :: Maybe Output
, pretty :: Bool
} }
genJSONOpts :: Parser GenJSONOpts genJSONOpts :: Parser GenJSONOpts
genJSONOpts = GenJSONOpts <$> optional outputP genJSONOpts = GenJSONOpts <$> optional outputP <*> switch
(short 'p' <> long "pretty" <> help "Make JSON output pretty (human readable)"
)
data Input data Input
@ -134,14 +138,16 @@ main = do
customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of >>= \Options {..} -> case optCommand of
GenJSON gopts -> do GenJSON gopts -> do
let let bs True =
bs = encodePretty' (defConfig { confIndent = Spaces 2 }) encodePretty' (defConfig { confIndent = Spaces 2 }) ghcupInfo
ghcupInfo bs False = encode ghcupInfo
case gopts of case gopts of
GenJSONOpts { output = Nothing } -> L.hPutStr stdout bs GenJSONOpts { output = Nothing, pretty } ->
GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs L.hPutStr stdout (bs pretty)
GenJSONOpts { output = Just (FileOutput file) } -> GenJSONOpts { output = Just StdOutput, pretty } ->
L.writeFile file bs L.hPutStr stdout (bs pretty)
GenJSONOpts { output = Just (FileOutput file), pretty } ->
L.writeFile file (bs pretty)
ValidateJSON vopts -> case vopts of ValidateJSON vopts -> case vopts of
ValidateJSONOpts { input = Nothing } -> ValidateJSONOpts { input = Nothing } ->
L.getContents >>= valAndExit validate L.getContents >>= valAndExit validate
@ -165,4 +171,3 @@ main = do
Left e -> die (color Red $ show e) Left e -> die (color Red $ show e)
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av) myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)
>>= exitWith >>= exitWith

2166
ghcup-0.0.1.json
View File

File diff suppressed because one or more lines are too long