Skip to content

Convert Json module from String to ByteString #6948

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 1 commit into from
Closed

Convert Json module from String to ByteString #6948

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions Cabal/Cabal.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -346,7 +346,7 @@ library

if !impl(ghc >= 7.8)
-- semigroups depends on tagged.
build-depends: tagged >=0.8.6 && <0.9
build-depends: tagged >=0.8.6 && <0.9, bytestring-builder >= 0.10.8 && <0.11
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is wrong as is, but I'll fix it before merge. One can have older bytestring on newer GHC, though that is contrived corner-case. But Cabal should be exemplary in own definition :)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Don't we need a newer bytestring on an older GHC here though?


exposed-modules:
Distribution.Backpack
Expand Down Expand Up @@ -524,6 +524,7 @@ library
Distribution.Types.GivenComponent
Distribution.Types.PackageVersionConstraint
Distribution.Utils.Generic
Distribution.Utils.Json
Distribution.Utils.NubList
Distribution.Utils.ShortText
Distribution.Utils.Progress
Expand Down Expand Up @@ -606,7 +607,6 @@ library
Distribution.Simple.GHC.EnvironmentParser
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.ImplInfo
Distribution.Simple.Utils.Json
Distribution.ZinzaPrelude
Paths_Cabal

Expand Down Expand Up @@ -685,7 +685,7 @@ test-suite unit-tests
Distribution.Described
Distribution.Utils.CharSet
Distribution.Utils.GrammarRegex

main-is: UnitTests.hs
build-depends:
array,
Expand Down
5 changes: 3 additions & 2 deletions Cabal/src/Distribution/Simple.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,7 @@ import Distribution.Compat.Directory (makeAbsolute)
import Distribution.Compat.Environment (getEnvironment)
import Distribution.Compat.GetShortPathName (getShortPathName)

import qualified Data.ByteString.Lazy as B
import Data.List (unionBy, (\\))

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

case fileOutput of
Nothing -> putStr buildInfoString
Just fp -> writeFile fp buildInfoString
Nothing -> B.putStr buildInfoString
Just fp -> B.writeFile fp buildInfoString

postBuild hooks args flags' pkg_descr lbi'

Expand Down
7 changes: 4 additions & 3 deletions Cabal/src/Distribution/Simple/Build.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ import Distribution.Simple.Configure
import Distribution.Simple.Register
import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
import Distribution.Simple.Utils.Json
import Distribution.Utils.Json

import Distribution.System
import Distribution.Pretty
Expand All @@ -86,6 +86,7 @@ import Distribution.Version (thisVersion)
import Distribution.Compat.Graph (IsNode(..))

import Control.Monad
import Data.ByteString.Lazy (ByteString)
import qualified Data.Set as Set
import System.FilePath ( (</>), (<.>), takeDirectory )
import System.Directory ( getCurrentDirectory )
Expand Down Expand Up @@ -135,13 +136,13 @@ build pkg_descr lbi flags suffixes = do
showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
-> LocalBuildInfo -- ^ Configuration information
-> BuildFlags -- ^ Flags that the user passed to build
-> IO String
-> IO ByteString
showBuildInfo pkg_descr lbi flags = do
let verbosity = fromFlag (buildVerbosity flags)
targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
doc = mkBuildInfo pkg_descr lbi flags targetsToBuild
return $ renderJson doc ""
return $ renderJson doc


repl :: PackageDescription -- ^ Mostly information from the .cabal file
Expand Down
4 changes: 1 addition & 3 deletions Cabal/src/Distribution/Simple/ShowBuildInfo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Simple.Utils.Json
import Distribution.Utils.Json
import Distribution.Types.TargetInfo
import Distribution.Text
import Distribution.Pretty
Expand All @@ -88,8 +88,6 @@ mkBuildInfo pkg_descr lbi _flags targetsToBuild = info
targetToNameAndLBI target =
(componentLocalName $ targetCLBI target, targetCLBI target)
componentsToBuild = map targetToNameAndLBI targetsToBuild
(.=) :: String -> Json -> (String, Json)
k .= v = (k, v)

info = JsonObject
[ "cabal-version" .= JsonString (display cabalVersion)
Expand Down
46 changes: 0 additions & 46 deletions Cabal/src/Distribution/Simple/Utils/Json.hs
View file
Open in desktop

This file was deleted.

54 changes: 54 additions & 0 deletions Cabal/src/Distribution/Utils/Json.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,54 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Extremely simple JSON helper. Don't do anything too fancy with this!

module Distribution.Utils.Json
( Json(..)
, (.=)
, renderJson
) where

import Distribution.Compat.Prelude
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString.Builder
( Builder, stringUtf8, intDec, toLazyByteString )

data Json = JsonArray [Json]
| JsonBool !Bool
| JsonNull
| JsonNumber !Int -- No support for Floats, Doubles just yet
| JsonObject [(String, Json)]
| JsonString !String
deriving Show

-- | Convert a 'Json' into a 'ByteString'
renderJson :: Json -> LBS.ByteString
renderJson json = toLazyByteString (go json)
where
go (JsonArray objs) =
surround "[" "]" $ mconcat $ intersperse "," $ map go objs
go (JsonBool True) = stringUtf8 "true"
go (JsonBool False) = stringUtf8 "false"
go JsonNull = stringUtf8 "null"
go (JsonNumber n) = intDec n
go (JsonObject attrs) =
surround "{" "}" $ mconcat $ intersperse "," $ map render attrs
where
render (k,v) = (surround "\"" "\"" $ stringUtf8 (escape k)) <> ":" <> go v
go (JsonString s) = surround "\"" "\"" $ stringUtf8 (escape s)

surround :: Builder -> Builder -> Builder -> Builder
surround begin end middle = mconcat [ begin , middle , end]

escape :: String -> String
escape ('\"':xs) = "\\\"" <> escape xs
escape ('\\':xs) = "\\\\" <> escape xs
escape ('\'':xs) = "\\\'" <> escape xs
escape (x:xs) = x : escape xs
escape [] = mempty

-- | A shorthand for building up 'JsonObject's
-- >>> JsonObject [ "a" .= JsonNumber 42, "b" .= JsonBool True ]
-- JsonObject [("a",JsonNumber 42),("b",JsonBool True)]
(.=) :: String -> Json -> (String, Json)
k .= v = (k, v)