Skip to content

Instantly share code, notes, and snippets.

@ruslantalpa

ruslantalpa/pizza.json

Last active November 18, 2015 09:37
Show Gist options
  • Save ruslantalpa/92b42fdb87f0ce9a98c7 to your computer and use it in GitHub Desktop.
Save ruslantalpa/92b42fdb87f0ce9a98c7 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
pizza.json
[
{ "firstName" : "Daniel"
, "lastName" : "Díaz"
, "age" : 24
, "likesPizza" : true
}
,
{ "firstName" : "Rose"
, "lastName" : "Red"
, "age" : 39
, "likesPizza" : false
}
, { "firstName" : "John"
, "lastName" : "Doe"
, "age" : 45
, "likesPizza" : false
}
, { "firstName" : "Vladimir"
, "lastName" : "Vygodsky"
, "age" : 27
, "likesPizza" : false
}
, { "firstName" : "Foo"
, "lastName" : "Bar"
, "age" : 32
, "likesPizza" : true
}
, { "firstName" : "María"
, "lastName" : "Delaoh"
, "age" : 52
, "likesPizza" : false
}
, { "firstName" : "Victoria"
, "lastName" : "Haskell"
, "age" : 23
, "likesPizza" : true
}
, { "firstName" : "François"
, "lastName" : "Beaulieu"
, "age" : 42
, "likesPizza" : false
}
, { "firstName" : "Amalie"
, "lastName" : "Baumann"
, "age" : 28
, "likesPizza" : true
}
, { "firstName" : "Rachel"
, "lastName" : "Scott"
, "age" : 23
, "likesPizza" : true
}
]
Raw
tt.hs
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
import Data.Aeson
import Data.List (transpose)
import Data.Text (Text, intercalate, takeWhile, replace, isInfixOf)
import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Lazy as B
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import Data.Monoid ((<>))
import Data.String.Conversions (cs)
import Data.Scientific ( FPFormat (..)
, formatScientific
, isInteger
)
jsonFile :: FilePath
jsonFile = "pizza.json"
getJSON :: IO B.ByteString
getJSON = B.readFile jsonFile
convertJson :: Value -> Either String ([Text],[[Value]])
convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
where
invalidMsg = "Expecting single JSON object or JSON array of objects"
normalized :: Either String [(Text, [Value])]
normalized = groupByKey =<< normalizeValue v
vals :: [(Text, [Value])] -> [[Value]]
vals = transpose . map snd
header :: [(Text, [Value])] -> [Text]
header = map fst
groupByKey :: Value -> Either String [(Text,[Value])]
groupByKey (Array a) = HM.toList . foldr (HM.unionWith (++)) (HM.fromList []) <$> maps
where
maps :: Either String [HM.HashMap Text [Value]]
maps = mapM getElems $ V.toList a
getElems (Object o) = Right $ HM.map (:[]) o
getElems _ = Left invalidMsg
groupByKey _ = Left invalidMsg
normalizeValue :: Value -> Either String Value
normalizeValue val =
case val of
Object obj -> Right $ Array (V.fromList[Object obj])
a@(Array _) -> Right a
_ -> Left invalidMsg
checkStructure :: ([Text], [[Value]]) -> Either String ([Text], [[Value]])
checkStructure v
| headerMatchesContent v = Right v
| otherwise = Left "The number of keys in objects do not match"
headerMatchesContent :: ([Text], [[Value]]) -> Bool
headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
where headerLength = length header
insertableValue :: Value -> Text
insertableValue Null = "null"
insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
unquoted :: Value -> Text
unquoted (String t) = t
unquoted (Number n) =
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
unquoted (Bool b) = cs . show $ b
unquoted v = cs $ encode v
trimNullChars :: Text -> Text
trimNullChars = Data.Text.takeWhile (/= '\x0')
pgFmtLit :: Text -> Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> replace "'" "''" trimmed <> "'"
slashed = replace "\\" "\\\\" escaped in
if "\\\\" `isInfixOf` escaped
then "E" <> slashed
else slashed
valsToText :: [[Value]] -> Text
valsToText vals =
intercalate ", "
( map (\v ->
"(" <>
intercalate ", " ( map insertableValue v ) <>
")"
) vals
)
main :: IO ()
main = do
d <- (eitherDecode <$> getJSON) :: IO (Either String Value)
case d of
Left err -> putStrLn err
Right ps -> print (valsToText.snd <$> (checkStructure =<< convertJson ps))
Raw
tt.txt
Wed Nov 18 11:15 2015 Time and Allocation Profiling Report (Final)
tt +RTS -hc -p -RTS
total time = 2.35 secs (2348 ticks @ 1000 us, 1 processor)
total alloc = 3,237,342,944 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
jstring_ Data.Aeson.Parser.Internal 35.7 28.6
main Main 15.5 27.4
valsToText.\ Main 13.3 15.3
unquoted Main 8.2 4.6
pgFmtLit.escaped Main 6.0 7.5
trimNullChars Main 4.7 4.9
pgFmtLit Main 4.1 1.7
insertableValue Main 3.7 2.5
convertJson.groupByKey Main 2.0 1.4
pgFmtLit.slashed Main 1.8 0.8
object_ Data.Aeson.Parser.Internal 1.2 1.2
valsToText Main 1.1 1.6
convertJson Main 0.6 1.1
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 134 0 0.0 0.0 100.0 100.0
main Main 269 0 15.5 27.4 100.0 100.0
valsToText Main 294 1 1.1 1.6 43.4 38.9
valsToText.\ Main 295 85051 13.3 15.3 42.2 37.2
insertableValue Main 298 340204 3.7 2.5 29.0 22.0
unquoted Main 304 340204 8.2 4.6 8.5 4.7
unstream/resize Data.Text.Internal.Fusion 311 47250 0.3 0.2 0.3 0.2
pgFmtLit Main 299 340204 4.1 1.7 16.8 14.8
pgFmtLit.slashed Main 307 340204 1.8 0.8 1.8 0.8
pgFmtLit.escaped Main 305 340204 6.0 7.5 6.0 7.5
pgFmtLit.trimmed Main 301 340204 0.2 0.0 4.9 4.9
trimNullChars Main 303 0 4.7 4.9 4.7 4.9
checkStructure Main 290 1 0.0 0.0 0.1 0.0
headerMatchesContent Main 291 1 0.1 0.0 0.1 0.0
headerMatchesContent.headerLength Main 292 1 0.0 0.0 0.0 0.0
convertJson Main 279 1 0.6 1.1 3.6 3.6
convertJson.header Main 293 1 0.0 0.0 0.0 0.0
convertJson.vals Main 287 1 0.0 0.0 0.0 0.0
convertJson.groupByKey Main 284 0 0.1 0.0 0.1 0.0
convertJson.normalized Main 280 1 0.0 0.0 2.9 2.5
convertJson.groupByKey Main 282 1 2.0 1.4 2.9 2.5
convertJson.groupByKey.maps Main 283 1 0.0 0.1 0.9 1.1
convertJson.groupByKey.getElems Main 286 85051 0.9 1.0 0.9 1.0
convertJson.normalizeValue Main 281 1 0.0 0.0 0.0 0.0
array_ Data.Aeson.Parser.Internal 274 0 0.0 0.0 36.9 29.8
object_ Data.Aeson.Parser.Internal 276 0 1.2 1.2 36.9 29.8
jstring_ Data.Aeson.Parser.Internal 278 170102 35.7 28.6 35.7 28.6
getJSON Main 271 0 0.5 0.3 0.5 0.3
CAF Main 267 0 0.0 0.0 0.0 0.0
insertableValue Main 309 0 0.0 0.0 0.0 0.0
unstream/resize Data.Text.Internal.Fusion 310 1 0.0 0.0 0.0 0.0
trimNullChars Main 302 1 0.0 0.0 0.0 0.0
pgFmtLit Main 300 0 0.0 0.0 0.0 0.0
pgFmtLit.slashed Main 308 0 0.0 0.0 0.0 0.0
pgFmtLit.escaped Main 306 0 0.0 0.0 0.0 0.0
valsToText Main 296 0 0.0 0.0 0.0 0.0
valsToText.\ Main 297 0 0.0 0.0 0.0 0.0
jsonFile Main 272 1 0.0 0.0 0.0 0.0
getJSON Main 270 1 0.0 0.0 0.0 0.0
main Main 268 1 0.0 0.0 0.0 0.0
CAF Data.Aeson.Parser.Internal 261 0 0.0 0.0 0.0 0.0
jstring_ Data.Aeson.Parser.Internal 277 1 0.0 0.0 0.0 0.0
object_ Data.Aeson.Parser.Internal 275 1 0.0 0.0 0.0 0.0
array_ Data.Aeson.Parser.Internal 273 1 0.0 0.0 0.0 0.0
CAF Data.Either 187 0 0.0 0.0 0.0 0.0
CAF GHC.Conc.Signal 183 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding 175 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 173 0 0.0 0.0 0.0 0.0
CAF GHC.IO.FD 167 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 165 0 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.Text 163 0 0.0 0.0 0.0 0.0
CAF GHC.Show 157 0 0.0 0.0 0.0 0.0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment