Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated about an hour ago

total matches: more than 1000

aeson-1.4.6.0
25 matches
Data/Aeson/Encoding/Internal.hs

instance Monoid Series where
    mempty  = Empty
    mappend = (<>)

nullEncoding :: Encoding' a -> Bool
nullEncoding = BSL.null . toLazyByteString . fromEncoding

emptyArray_ :: Encoding

            
Data/Aeson/Internal/Functions.hs

module Data.Aeson.Internal.Functions
    (
      mapHashKeyVal
    , mapKeyVal
    , mapKey
    ) where

import Prelude.Compat

import Data.Hashable (Hashable)

            
Data/Aeson/Internal/Functions.hs
import qualified Data.Map as M

-- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.
mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
              -> M.Map k1 v1 -> H.HashMap k2 v2
mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
{-# INLINE mapHashKeyVal #-}

-- | Transform the keys and values of a 'H.HashMap'.
mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
          -> H.HashMap k1 v1 -> H.HashMap k2 v2
mapKeyVal fk kv = H.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
{-# INLINE mapKeyVal #-}

-- | Transform the keys of a 'H.HashMap'.
mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> H.HashMap k1 v -> H.HashMap k2 v
mapKey fk = mapKeyVal fk id
{-# INLINE mapKey #-}

            
Data/Aeson/Parser/Internal.hs
jsonLast :: Parser Value
jsonLast = jsonWith (Right . H.fromListWith (const id))

-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
-- key-value pairs with the same keys.
jsonAccum :: Parser Value
jsonAccum = jsonWith (Right . fromListAccum)

-- | Variant of 'json' which fails if any object contains duplicate keys.

            
Data/Aeson/Parser/Internal.hs
jsonNoDup :: Parser Value
jsonNoDup = jsonWith parseListNoDup

-- | @'fromListAccum' kvs@ is an object mapping keys to arrays containing all
-- associated values from the original list @kvs@.
--
-- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)]
-- fromList [("apple", [Bool False, Bool True]), ("orange", [Bool False])]
fromListAccum :: [(Text, Value)] -> Object

            
Data/Aeson/Parser/Internal.hs
-- fromList [("apple", [Bool False, Bool True]), ("orange", [Bool False])]
fromListAccum :: [(Text, Value)] -> Object
fromListAccum =
  fmap (Array . Vector.fromList . ($ [])) . H.fromListWith (.) . (fmap . fmap) (:)

-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.
parseListNoDup :: [(Text, Value)] -> Either String Object
parseListNoDup =
  H.traverseWithKey unwrap . H.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just

            
Data/Aeson/Parser/Internal.hs
-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.
parseListNoDup :: [(Text, Value)] -> Either String Object
parseListNoDup =
  H.traverseWithKey unwrap . H.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just
  where
    unwrap k Nothing = Left $ "found duplicate key: " ++ show k
    unwrap _ (Just v) = Right v

-- | Strict version of 'value'. Synonym of 'json''.

            
Data/Aeson/Parser/Internal.hs
jsonLast' :: Parser Value
jsonLast' = jsonWith' (pure . H.fromListWith (const id))

-- | Variant of 'json'' wrapping all object mappings in 'Array' to preserve
-- key-value pairs with the same keys.
jsonAccum' :: Parser Value
jsonAccum' = jsonWith' (pure . fromListAccum)

-- | Variant of 'json'' which fails if any object contains duplicate keys.

            
Data/Aeson/Parser/Internal.hs
  let littleE = 101
      bigE    = 69
  (A.satisfy (\ex -> ex == littleE || ex == bigE) *>
      fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>
    return (Sci.scientific signedCoeff    e)
{-# INLINE scientific #-}

------------------ Copy-pasted and adapted from base ------------------------


            
Data/Aeson/TH.hs
lower-casing them:

@
$('deriveJSON' 'defaultOptions'{'fieldLabelModifier' = 'drop' 4, 'constructorTagModifier' = map toLower} ''D)
@

Now we can use the newly created instances.

@

            
Data/Aeson/TH.hs
import Data.List (foldl', genericLength, intercalate, partition, union)
import Data.List.NonEmpty ((<|), NonEmpty((:|)))
import Data.Map (Map)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import qualified Data.Monoid as Monoid
import Data.Set (Set)
#if MIN_VERSION_template_haskell(2,8,0)
import Language.Haskell.TH hiding (Arity)
#else

            
Data/Aeson/TH.hs
    tjls  <- newNameList "_tjl" $ arityInt jc
    let zippedTJs      = zip tjs tjls
        interleavedTJs = interleave tjs tjls
        lastTyVars     = map varTToName $ drop (length instTys - arityInt jc) instTys
        tvMap          = M.fromList $ zip lastTyVars zippedTJs
    lamE (map varP $ interleavedTJs ++ [value]) $
        caseE (varE value) (matches tvMap)
  where
    matches tvMap = case cons of
      -- A single constructor is directly encoded. The constructor itself may be
      -- forgotten.

            
Data/Aeson/TH.hs
  ConstructorInfo { constructorName    = conName
                  , constructorVariant = NormalConstructor
                  , constructorFields  = argTys } = do
    argTys' <- mapM resolveTypeSynonyms argTys
    let len = length argTys'
    args <- newNameList "arg" len
    let js = case [ dispatchToJSON target jc conName tvMap argTy
                      `appE` varE arg
                  | (arg, argTy) <- zip args argTys'

            
Data/Aeson/TH.hs
               -- Zero and multiple arguments are converted to a JSON array.
               es -> array target es

    match (conP conName $ map varP args)
          (normalB $ opaqueSumToValue target opts multiCons (null argTys') conName js)
          []

-- Records.
argsToValue target jc tvMap opts multiCons

            
Data/Aeson/TH.hs
      (True,True,[_]) -> argsToValue target jc tvMap opts multiCons
                                     (info{constructorVariant = NormalConstructor})
      _ -> do
        argTys' <- mapM resolveTypeSynonyms argTys
        args <- newNameList "arg" $ length argTys'
        let pairs | omitNothingFields opts = infixApp maybeFields
                                                      [|(Monoid.<>)|]
                                                      restFields
                  | otherwise = mconcatE (map pureToPair argCons)

            
Data/Aeson/TH.hs
        let pairs | omitNothingFields opts = infixApp maybeFields
                                                      [|(Monoid.<>)|]
                                                      restFields
                  | otherwise = mconcatE (map pureToPair argCons)

            argCons = zip3 (map varE args) argTys' fields

            maybeFields = mconcatE (map maybeToPair maybes)

            restFields = mconcatE (map pureToPair rest)

            (maybes0, rest0) = partition isMaybe argCons
            (options, rest) = partition isOption rest0
            maybes = maybes0 ++ map optionToMaybe options

            maybeToPair = toPairLifted True
            pureToPair = toPairLifted False

            toPairLifted lifted (arg, argTy, field) =

            
Data/Aeson/TH.hs
                  [|maybe mempty|] `appE` lam1E (varP x) (e (varE x)) `appE` arg
                else e arg

        match (conP conName $ map varP args)
              (normalB $ recordSumToValue target opts multiCons (null argTys) conName pairs)
              []

-- Infix constructors.
argsToValue target jc tvMap opts multiCons

            
Data/Aeson/TH.hs
  ConstructorInfo { constructorName    = conName
                  , constructorVariant = InfixConstructor
                  , constructorFields  = argTys } = do
    [alTy, arTy] <- mapM resolveTypeSynonyms argTys
    al <- newName "argL"
    ar <- newName "argR"
    match (infixP (varP al) conName (varP ar))
          ( normalB
          $ opaqueSumToValue target opts multiCons False conName

            
Data/Aeson/TH.hs

-- | Wrap an associative list of keys and quoted values in a quoted 'Object'.
objectE :: [(String, ExpQ)] -> ExpQ
objectE = fromPairsE . mconcatE . fmap (uncurry pairE)

-- | 'mconcat' a list of fixed length.
--
-- > mconcatE [ [|x|], [|y|], [|z|] ] = [| x <> (y <> z) |]
mconcatE :: [ExpQ] -> ExpQ

            
Data/Aeson/TH.hs
  pjls  <- newNameList "_pjl" $ arityInt jc
  let zippedPJs      = zip pjs pjls
      interleavedPJs = interleave pjs pjls
      lastTyVars     = map varTToName $ drop (length instTys - arityInt jc) instTys
      tvMap          = M.fromList $ zip lastTyVars zippedPJs
  lamE (map varP $ interleavedPJs ++ [value]) $ lamExpr value tvMap

  where
    checkExi tvMap con = checkExistentialContext jc tvMap
                                                 (constructorContext con)
                                                 (constructorName con)

            
Data/Aeson/TH.hs

    parseUntaggedValue tvMap cons' conVal =
        foldr1 (\e e' -> infixApp e [|(<|>)|] e')
               (map (\x -> parseValue tvMap x conVal) cons')

    parseValue _tvMap
        ConstructorInfo { constructorName    = conName
                        , constructorVariant = NormalConstructor
                        , constructorFields  = [] }

            
Data/Aeson/TH.hs
                                 (normalG [e|otherwise|])
                                 ( varE errorFun
                                   `appE` litE (stringL $ show tName)
                                   `appE` listE (map ( litE
                                                     . stringL
                                                     . constructorTagModifier opts
                                                     . nameBase
                                                     . constructorName
                                                     ) cons

            
Data/Aeson/TH.hs
                  , constructorVariant = NormalConstructor
                  , constructorFields  = argTys }
  contents = do
    argTys' <- mapM resolveTypeSynonyms argTys
    let len = genericLength argTys'
    matchCases contents $ parseProduct jc tvMap argTys' tName conName len

-- Records.
parseArgs jc tvMap tName opts

            
Data/Aeson/TH.hs
                  , constructorVariant = RecordConstructor fields
                  , constructorFields  = argTys }
  (Left (_, obj)) = do
    argTys' <- mapM resolveTypeSynonyms argTys
    parseRecord jc tvMap argTys' opts tName conName fields obj
parseArgs jc tvMap tName opts
  info@ConstructorInfo { constructorName    = conName
                       , constructorVariant = RecordConstructor fields
                       , constructorFields  = argTys }

            
Data/Aeson/TH.hs
                             (Right valName)
      _ -> do
        obj <- newName "recObj"
        argTys' <- mapM resolveTypeSynonyms argTys
        caseE (varE valName)
          [ match (conP 'Object [varP obj]) (normalB $
              parseRecord jc tvMap argTys' opts tName conName fields obj) []
          , matchFailed tName conName "Object"
          ]

            
aeson-extra-0.4.1.3
1 matches
src/Data/Aeson/Extra.hs
module Data.Aeson.Extra (
  -- * Strict encoding
  encodeStrict,
  -- * Generic maps
  M(..),
  FromJSONKey(..),
  parseIntegralJSONKey,
  FromJSONMap(..),
  ToJSONKey(..),

            
aeson-pretty-0.8.8
2 matches
Data/Aeson/Encode/Pretty.hs
    --  function such as
    --
    --  > comp :: Text -> Text -> Ordering
    --  > comp = keyOrder ["foo","bar"] `mappend` comparing length
    --
    --  we can achieve the desired neat result:
    --
    --  > {
    --  >   "foo": ...,

            
Data/Aeson/Encode/Pretty.hs
    ]
  where
    items' = mconcat . intersperse (pItemSep <> pNewline) $
                map (\item -> fromIndent st' <> fromItem st' item)
                    items
    st' = st { pLevel = pLevel + 1}

fromPair :: PState -> (Text, Value) -> Builder
fromPair st (k,v) =

            
aeson-qq-0.8.3
2 matches
src/Data/Aeson/QQ.hs
toExp (JsonObject objs) = [|object $jsList|]
    where
      jsList :: ExpQ
      jsList = ListE <$> mapM objs2list (objs)

      objs2list :: (HashKey, JsonValue) -> ExpQ
      objs2list (key, value) = do
        case key of
          HashStringKey k -> [|(T.pack k, $(toExp value))|]

            
src/Data/Aeson/QQ.hs
        case key of
          HashStringKey k -> [|(T.pack k, $(toExp value))|]
          HashVarKey k -> [|(T.pack $(dyn k), $(toExp value))|]
toExp (JsonArray arr) = [|Array $ V.fromList $(ListE <$> mapM toExp arr)|]
toExp (JsonNumber n) = [|Number (fromRational $(return $ LitE $ RationalL (toRational n)))|]
toExp (JsonBool b) = [|Bool b|]
toExp (JsonCode e) = [|toJSON $(return e)|]