Skip to content

Commit e5e36e3

Browse files
lukel97lukel97
committed
Convert Json module from String to ByteString
1 parent 44cfe7d commit e5e36e3

File tree

6 files changed

+80
-68
lines changed

6 files changed

+80
-68
lines changed

‎Cabal/Cabal.cabal

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -527,6 +527,7 @@ library
527527
Distribution.Types.GivenComponent
528528
Distribution.Types.PackageVersionConstraint
529529
Distribution.Utils.Generic
530+
Distribution.Utils.Json
530531
Distribution.Utils.NubList
531532
Distribution.Utils.ShortText
532533
Distribution.Utils.Progress
@@ -609,7 +610,6 @@ library
609610
Distribution.Simple.GHC.EnvironmentParser
610611
Distribution.Simple.GHC.Internal
611612
Distribution.Simple.GHC.ImplInfo
612-
Distribution.Simple.Utils.Json
613613
Distribution.ZinzaPrelude
614614
Paths_Cabal
615615

@@ -689,7 +689,7 @@ test-suite unit-tests
689689
Distribution.Described
690690
Distribution.Utils.CharSet
691691
Distribution.Utils.GrammarRegex
692-
692+
693693
main-is: UnitTests.hs
694694
build-depends:
695695
array,

‎Cabal/Distribution/Simple.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,7 @@ import Distribution.Compat.Directory (makeAbsolute)
104104
import Distribution.Compat.Environment (getEnvironment)
105105
import Distribution.Compat.GetShortPathName (getShortPathName)
106106

107+
import qualified Data.ByteString.Lazy as B
107108
import Data.List (unionBy, (\\))
108109

109110
import Distribution.PackageDescription.Parsec
@@ -286,8 +287,8 @@ showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do
286287
buildInfoString <- showBuildInfo pkg_descr lbi' flags
287288

288289
case fileOutput of
289-
Nothing -> putStr buildInfoString
290-
Just fp -> writeFile fp buildInfoString
290+
Nothing -> B.putStr buildInfoString
291+
Just fp -> B.writeFile fp buildInfoString
291292

292293
postBuild hooks args flags' pkg_descr lbi'
293294

‎Cabal/Distribution/Simple/Build.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ import Distribution.Simple.Configure
7676
import Distribution.Simple.Register
7777
import Distribution.Simple.Test.LibV09
7878
import Distribution.Simple.Utils
79-
import Distribution.Simple.Utils.Json
79+
import Distribution.Utils.Json
8080

8181
import Distribution.System
8282
import Distribution.Pretty
@@ -86,6 +86,7 @@ import Distribution.Version (thisVersion)
8686
import Distribution.Compat.Graph (IsNode(..))
8787

8888
import Control.Monad
89+
import Data.ByteString.Lazy (ByteString)
8990
import qualified Data.Set as Set
9091
import System.FilePath ( (</>), (<.>), takeDirectory )
9192
import System.Directory ( getCurrentDirectory )
@@ -135,13 +136,13 @@ build pkg_descr lbi flags suffixes = do
135136
showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
136137
-> LocalBuildInfo -- ^ Configuration information
137138
-> BuildFlags -- ^ Flags that the user passed to build
138-
-> IO String
139+
-> IO ByteString
139140
showBuildInfo pkg_descr lbi flags = do
140141
let verbosity = fromFlag (buildVerbosity flags)
141142
targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
142143
let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
143144
doc = mkBuildInfo pkg_descr lbi flags targetsToBuild
144-
return $ renderJson doc ""
145+
return $ renderJson doc
145146

146147

147148
repl :: PackageDescription -- ^ Mostly information from the .cabal file

‎Cabal/Distribution/Simple/ShowBuildInfo.hs

Lines changed: 17 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,8 @@
5454
-- Note: At the moment this is only supported when using the GHC compiler.
5555
--
5656

57+
{-# LANGUAGE OverloadedStrings #-}
58+
5759
module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where
5860

5961
import Distribution.Compat.Prelude
@@ -70,11 +72,13 @@ import Distribution.Simple.LocalBuildInfo
7072
import Distribution.Simple.Program
7173
import Distribution.Simple.Setup
7274
import Distribution.Simple.Utils (cabalVersion)
73-
import Distribution.Simple.Utils.Json
75+
import Distribution.Utils.Json
7476
import Distribution.Types.TargetInfo
7577
import Distribution.Text
7678
import Distribution.Pretty
7779

80+
import qualified Data.ByteString.Lazy.Char8 as B
81+
7882
-- | Construct a JSON document describing the build information for a
7983
-- package.
8084
mkBuildInfo
@@ -88,22 +92,20 @@ mkBuildInfo pkg_descr lbi _flags targetsToBuild = info
8892
targetToNameAndLBI target =
8993
(componentLocalName $ targetCLBI target, targetCLBI target)
9094
componentsToBuild = map targetToNameAndLBI targetsToBuild
91-
(.=) :: String -> Json -> (String, Json)
92-
k .= v = (k, v)
9395

9496
info = JsonObject
95-
[ "cabal-version" .= JsonString (display cabalVersion)
97+
[ "cabal-version" .= JsonString (B.pack $ display cabalVersion)
9698
, "compiler" .= mkCompilerInfo
9799
, "components" .= JsonArray (map mkComponentInfo componentsToBuild)
98100
]
99101

100102
mkCompilerInfo = JsonObject
101-
[ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi)
102-
, "compiler-id" .= JsonString (showCompilerId $ compiler lbi)
103+
[ "flavour" .= JsonString (B.pack $ prettyShow $ compilerFlavor $ compiler lbi)
104+
, "compiler-id" .= JsonString (B.pack $ showCompilerId $ compiler lbi)
103105
, "path" .= path
104106
]
105107
where
106-
path = maybe JsonNull (JsonString . programPath)
108+
path = maybe JsonNull (JsonString . B.pack . programPath)
107109
$ (flavorToProgram . compilerFlavor $ compiler lbi)
108110
>>= flip lookupProgram (withPrograms lbi)
109111

@@ -115,13 +117,13 @@ mkBuildInfo pkg_descr lbi _flags targetsToBuild = info
115117
flavorToProgram _ = Nothing
116118

117119
mkComponentInfo (name, clbi) = JsonObject
118-
[ "type" .= JsonString compType
119-
, "name" .= JsonString (prettyShow name)
120-
, "unit-id" .= JsonString (prettyShow $ componentUnitId clbi)
120+
[ "type" .= JsonString (B.pack compType)
121+
, "name" .= JsonString (B.pack $ prettyShow name)
122+
, "unit-id" .= JsonString (B.pack $ prettyShow $ componentUnitId clbi)
121123
, "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
122-
, "modules" .= JsonArray (map (JsonString . display) modules)
123-
, "src-files" .= JsonArray (map JsonString sourceFiles)
124-
, "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi)
124+
, "modules" .= JsonArray (map (JsonString . B.pack . display) modules)
125+
, "src-files" .= JsonArray (map (JsonString . B.pack) sourceFiles)
126+
, "src-dirs" .= JsonArray (map (JsonString . B.pack) $ hsSourceDirs bi)
125127
]
126128
where
127129
bi = componentBuildInfo comp
@@ -147,7 +149,7 @@ getCompilerArgs
147149
:: BuildInfo
148150
-> LocalBuildInfo
149151
-> ComponentLocalBuildInfo
150-
-> [String]
152+
-> [B.ByteString]
151153
getCompilerArgs bi lbi clbi =
152154
case compilerFlavor $ compiler lbi of
153155
GHC -> ghc
@@ -156,6 +158,6 @@ getCompilerArgs bi lbi clbi =
156158
"build arguments for compiler "++show c
157159
where
158160
-- This is absolutely awful
159-
ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts
161+
ghc = map B.pack $ GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts
160162
where
161163
baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi)

‎Cabal/Distribution/Simple/Utils/Json.hs

Lines changed: 0 additions & 46 deletions
This file was deleted.

‎Cabal/Distribution/Utils/Json.hs

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
-- | Extremely simple JSON helper. Don't do anything too fancy with this!
3+
4+
module Distribution.Utils.Json
5+
( Json(..)
6+
, (.=)
7+
, renderJson
8+
) where
9+
10+
import Data.ByteString.Lazy (ByteString)
11+
import qualified Data.ByteString.Lazy as L
12+
import qualified Data.ByteString.Lazy.Char8 as C
13+
import Data.ByteString.Builder
14+
import Data.List (intersperse)
15+
16+
data Json = JsonArray [Json]
17+
| JsonBool !Bool
18+
| JsonNull
19+
| JsonNumber !Int
20+
| JsonObject [(ByteString, Json)]
21+
| JsonString !ByteString
22+
23+
renderJson :: Json -> L.ByteString
24+
renderJson json = toLazyByteString (go json)
25+
where
26+
go (JsonArray objs) =
27+
surround "[" "]" $ mconcat $ intersperse (stringUtf8 ",") $ map go objs
28+
go (JsonBool True) = stringUtf8 "true"
29+
go (JsonBool False) = stringUtf8 "false"
30+
go JsonNull = stringUtf8 "null"
31+
go (JsonNumber n) = intDec n
32+
go (JsonObject attrs) =
33+
surround "{" "}" $ mconcat $ intersperse (stringUtf8 ",") $ map render attrs
34+
where
35+
render (k,v) = (surround "\"" "\"" $ escape k) <> stringUtf8 ":" <> go v
36+
go (JsonString s) = surround "\"" "\"" $ escape s
37+
38+
surround :: ByteString -> ByteString -> Builder -> Builder
39+
surround begin end middle = mconcat [ lazyByteString begin , middle , lazyByteString end]
40+
41+
escape :: ByteString -> Builder
42+
escape = escapeWorker
43+
where
44+
escapeWorker :: ByteString -> Builder
45+
escapeWorker s =
46+
case C.uncons s of
47+
Just ('\"', xs) -> stringUtf8 "\\\"" <> escapeWorker xs
48+
Just ('\\', xs) -> stringUtf8 "\\\\" <> escapeWorker xs
49+
Just ('\'', xs) -> stringUtf8 "\\\'" <> escapeWorker xs
50+
Just (x, xs) -> charUtf8 x <> escapeWorker xs
51+
Nothing -> mempty
52+
53+
(.=) :: ByteString -> Json -> (ByteString, Json)
54+
k .= v = (k, v)

0 commit comments

Comments
 (0)