diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 72c09023ef0..f1f7bcae4ec 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -349,7 +349,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 exposed-modules: Distribution.Backpack @@ -527,6 +527,7 @@ library Distribution.Types.GivenComponent Distribution.Types.PackageVersionConstraint Distribution.Utils.Generic + Distribution.Utils.Json Distribution.Utils.NubList Distribution.Utils.ShortText Distribution.Utils.Progress @@ -609,7 +610,6 @@ library Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo - Distribution.Simple.Utils.Json Distribution.ZinzaPrelude Paths_Cabal @@ -689,7 +689,7 @@ test-suite unit-tests Distribution.Described Distribution.Utils.CharSet Distribution.Utils.GrammarRegex - + main-is: UnitTests.hs build-depends: array, diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 5543765a10d..c3ee006c193 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -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 @@ -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' diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index c7e5ebfdb92..cec02c4cfbf 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -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 @@ -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 ) @@ -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 diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index 74f5de2d41b..ce80174f4bb 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/Distribution/Simple/ShowBuildInfo.hs @@ -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 @@ -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) diff --git a/Cabal/Distribution/Simple/Utils/Json.hs b/Cabal/Distribution/Simple/Utils/Json.hs deleted file mode 100644 index f90f2f38aa2..00000000000 --- a/Cabal/Distribution/Simple/Utils/Json.hs +++ /dev/null @@ -1,46 +0,0 @@ --- | Utility json lib for Cabal --- TODO: Remove it again. -module Distribution.Simple.Utils.Json - ( Json(..) - , renderJson - ) where - -data Json = JsonArray [Json] - | JsonBool !Bool - | JsonNull - | JsonNumber !Int - | JsonObject [(String, Json)] - | JsonString !String - -renderJson :: Json -> ShowS -renderJson (JsonArray objs) = - surround "[" "]" $ intercalate "," $ map renderJson objs -renderJson (JsonBool True) = showString "true" -renderJson (JsonBool False) = showString "false" -renderJson JsonNull = showString "null" -renderJson (JsonNumber n) = shows n -renderJson (JsonObject attrs) = - surround "{" "}" $ intercalate "," $ map render attrs - where - render (k,v) = (surround "\"" "\"" $ showString' k) . showString ":" . renderJson v -renderJson (JsonString s) = surround "\"" "\"" $ showString' s - -surround :: String -> String -> ShowS -> ShowS -surround begin end middle = showString begin . middle . showString end - -showString' :: String -> ShowS -showString' xs = showStringWorker xs - where - showStringWorker :: String -> ShowS - showStringWorker ('\"':as) = showString "\\\"" . showStringWorker as - showStringWorker ('\\':as) = showString "\\\\" . showStringWorker as - showStringWorker ('\'':as) = showString "\\\'" . showStringWorker as - showStringWorker (x:as) = showString [x] . showStringWorker as - showStringWorker [] = showString "" - -intercalate :: String -> [ShowS] -> ShowS -intercalate sep = go - where - go [] = id - go [x] = x - go (x:xs) = x . showString' sep . go xs diff --git a/Cabal/Distribution/Utils/Json.hs b/Cabal/Distribution/Utils/Json.hs new file mode 100644 index 00000000000..b1bf3aeee57 --- /dev/null +++ b/Cabal/Distribution/Utils/Json.hs @@ -0,0 +1,52 @@ +{-# 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 + +-- | 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 ] +(.=) :: String -> Json -> (String, Json) +k .= v = (k, v)