Aelve Codesearch

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

total matches: 222

aeson-extra-0.4.1.2
9 matches
src/Data/Aeson/Extra/SingObject.hs
import Data.Proxy            (Proxy (..))
import Data.Semigroup.Compat ((<>))
import Data.Typeable         (Typeable)
import GHC.TypeLits          (KnownSymbol, Symbol, symbolVal)

import qualified Data.Text as T

#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson.Encoding (pair)

            
src/Data/Aeson/Extra/SingObject.hs

#if MIN_VERSION_aeson(1,0,0)

instance KnownSymbol s => FromJSON1 (SingObject s) where
    liftParseJSON p _ = withObject ("SingObject "<> show key) $ \obj ->
        case HM.lookup key obj of
            Nothing -> fail $ "key " ++ show key ++ " not present"
            Just v  -> SingObject <$> p v <?> Key key
     where

            
src/Data/Aeson/Extra/SingObject.hs
     where
        key = T.pack $ symbolVal (Proxy :: Proxy s)

instance KnownSymbol s => ToJSON1 (SingObject s) where
    liftToJSON     to _ (SingObject x) =
        object [ key .= to x]
      where
        key = T.pack $ symbolVal (Proxy :: Proxy s)
    liftToEncoding to _ (SingObject x) =

            
src/Data/Aeson/Extra/SingObject.hs
      where
        key = T.pack $ symbolVal (Proxy :: Proxy s)

instance  (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where
    parseJSON = parseJSON1

instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where
    toJSON     = toJSON1
    toEncoding = toEncoding1

#else
instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where

            
src/Data/Aeson/Extra/SingObject.hs
    toEncoding = toEncoding1

#else
instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where
  parseJSON = withObject ("SingObject "<> show key) $ \obj ->
    SingObject <$> obj .: T.pack key
    where key = symbolVal (Proxy :: Proxy s)

instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where

            
src/Data/Aeson/Extra/SingObject.hs
    SingObject <$> obj .: T.pack key
    where key = symbolVal (Proxy :: Proxy s)

instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where
#if MIN_VERSION_aeson(0,10,0)
  toEncoding (SingObject x) = pairs (T.pack key .= x)
    where key = symbolVal (Proxy :: Proxy s)
#endif
  toJSON (SingObject x) = object [T.pack key .= x]

            
src/Data/Aeson/Extra/SymTag.hs
import Data.Aeson.Compat
import Data.Aeson.Types  hiding ((.:?))
import Data.Proxy        (Proxy (..))
import GHC.TypeLits      (KnownSymbol, Symbol, symbolVal)

import qualified Data.Text as T

-- | Singleton string encoded and decoded as ifself.
--

            
src/Data/Aeson/Extra/SymTag.hs
data SymTag (s :: Symbol) = SymTag
  deriving (Eq, Ord, Show, Read, Enum, Bounded)

instance KnownSymbol s => FromJSON (SymTag s) where
  parseJSON (String t)
    | T.unpack t == symbolVal (Proxy :: Proxy s) = pure SymTag
  parseJSON v = typeMismatch ("SymTag " ++ show (symbolVal (Proxy :: Proxy s))) v

instance KnownSymbol s => ToJSON (SymTag s) where

            
src/Data/Aeson/Extra/SymTag.hs
    | T.unpack t == symbolVal (Proxy :: Proxy s) = pure SymTag
  parseJSON v = typeMismatch ("SymTag " ++ show (symbolVal (Proxy :: Proxy s))) v

instance KnownSymbol s => ToJSON (SymTag s) where
#if MIN_VERSION_aeson (0,10,0)
  toEncoding _ = toEncoding (symbolVal (Proxy :: Proxy s))
#endif
  toJSON _ = toJSON (symbolVal (Proxy :: Proxy s))


            
aeson-injector-1.1.1.0
6 matches
src/Data/Aeson/WithField.hs
-- Example of wrapper:
--
-- > { "id": 0, "value": [1, 2, 3] }
instance (KnownSymbol s, ToJSON a, ToJSON b) => ToJSON (WithField s a b) where
  toJSON (WithField a b) = let
    jsonb = toJSON b
    field = T.pack $ symbolVal (Proxy :: Proxy s)
    in case toJSON b of
      Object vs -> Object $ H.insert field (toJSON a) vs

            
src/Data/Aeson/WithField.hs
--
-- Note: The instance tries to parse the `b` part without `s` field at first time.
-- If it fails, the instance retries with presence of the `s` field.
instance (KnownSymbol s, FromJSON a, FromJSON b) => FromJSON (WithField s a b) where
  parseJSON val@(Object o) = injected <|> wrapper
    where
    field = T.pack $ symbolVal (Proxy :: Proxy s)
    injected = WithField
      <$> o .: field

            
src/Data/Aeson/WithField.hs
-- | Note: the instance tries to generate schema of the json as object with
-- additional field value, if it fails it assumes that it is a
-- wrapper produced by corresponding 'ToJSON' instance.
instance (KnownSymbol s, ToSchema a, ToSchema b) => ToSchema (WithField s a b) where
  declareNamedSchema _ = do
    NamedSchema n s <- declareNamedSchema (Proxy :: Proxy b)
    if s ^. type_ == SwaggerObject then inline n s
      else wrapper n s
    where

            
src/Data/Aeson/WithField.hs
    where
    as = snd <$> toSamples (Proxy :: Proxy a)

instance (KnownSymbol s, ToJSON a) => ToJSON (OnlyField s a) where
  toJSON (OnlyField a) = object [ field .= a ]
    where
    field = T.pack $ symbolVal (Proxy :: Proxy s)

instance (KnownSymbol s, FromJSON a) => FromJSON (OnlyField s a) where

            
src/Data/Aeson/WithField.hs
    where
    field = T.pack $ symbolVal (Proxy :: Proxy s)

instance (KnownSymbol s, FromJSON a) => FromJSON (OnlyField s a) where
  parseJSON (Object o) = OnlyField <$> o .: field
    where
    field = T.pack $ symbolVal (Proxy :: Proxy s)
  parseJSON _ = mzero


            
src/Data/Aeson/WithField.hs
    field = T.pack $ symbolVal (Proxy :: Proxy s)
  parseJSON _ = mzero

instance (KnownSymbol s, ToSchema a) => ToSchema (OnlyField s a) where
  declareNamedSchema _ = do
    NamedSchema an as <- declareNamedSchema (Proxy :: Proxy a)
    return $ NamedSchema (fmap ("OnlyField" <>) an) $ mempty
      & type_ .~ SwaggerObject
      & properties .~ [(field, Inline as)]

            
apiary-2.1.2
12 matches
src/Control/Monad/Apiary/Filter.hs
import qualified Data.CaseInsensitive  as CI
import Data.Monoid((<>))
import Data.Proxy(Proxy(..))
import GHC.TypeLits(KnownSymbol, Symbol, symbolVal)
import Data.Apiary.SProxy(SProxy(..))
import Data.Apiary.Routing.Dict(type (</), KV((:=)))
import qualified Data.Apiary.Routing.Dict as Dict
import qualified Data.Apiary.Routing as R


            
src/Control/Monad/Apiary/Filter.hs
    queryDesc = const Nothing

--     type SNext w (k::Symbol) a (prms :: [(Symbol, *)]) :: [(Symbol, *)]
query :: forall query strategy k v exts prms actM m. (k </ prms, MonadIO actM, KnownSymbol k, ReqParam v, HasDesc query, Strategy strategy)
      => query k -> strategy v -> Filter exts actM m prms (SNext strategy k v prms)
query k w = focus doc Nothing $ R.raw "query" $ \d t -> do
    qs      <- getQueryParams
    (ps,fs) <- getReqBodyInternal
    let as = map snd . filter ((SC.pack (symbolVal k) ==) . fst) $ reqParams (Proxy :: Proxy v) qs ps fs

            
src/Control/Monad/Apiary/Filter.hs
-- @
-- [key|key|] =: pInt
-- @
(=:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)
     => query k -> proxy v -> Filter exts actM m prms (k ':= v ': prms)
k =: v = query k (pFirst v)

-- | get one matched paramerer. since 0.5.0.0.
--

            
src/Control/Monad/Apiary/Filter.hs
-- @
-- [key|key|] =!: pInt
-- @
(=!:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)
      => query k -> proxy v -> Filter exts actM m prms (k ':= v ': prms)
k =!: t = query k (pOne t)

-- | get optional first paramerer. since 0.5.0.0.
--

            
src/Control/Monad/Apiary/Filter.hs
-- @
-- [key|key|] =?: pInt
-- @
(=?:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)
      => query k -> proxy v -> Filter exts actM m prms (k ':= Maybe v ': prms)
k =?: t = query k (pOption t)

-- | get optional first paramerer with default. since 0.16.0.
--

            
src/Control/Monad/Apiary/Filter.hs
-- @
-- [key|key|] =!?: (0 :: Int)
-- @
(=?!:) :: forall query k v exts prms actM m. (HasDesc query, MonadIO actM, Show v, ReqParam v, KnownSymbol k, k </ prms)
       => query k -> v -> Filter exts actM m prms (k ':= v ': prms)
k =?!: v = query k (pOptional v)

-- | get many paramerer. since 0.5.0.0.
--

            
src/Control/Monad/Apiary/Filter.hs
-- @
-- [key|key|] =*: pInt
-- @
(=*:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)
      => query k -> proxy v -> Filter exts actM m prms (k ':= [v] ': prms)
k =*: t = query k (pMany t)

-- | get some paramerer. since 0.5.0.0.
--

            
src/Control/Monad/Apiary/Filter.hs
-- @
-- [key|key|] =+: pInt
-- @
(=+:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)
      => query k -> proxy v -> Filter exts actM m prms (k ':= [v] ': prms)
k =+: t = query k (pSome t)

-- | get existance of key only query parameter. since v0.17.0.
switchQuery :: (HasDesc proxy, MonadIO actM, KnownSymbol k, k </ prms)

            
src/Control/Monad/Apiary/Filter.hs
k =+: t = query k (pSome t)

-- | get existance of key only query parameter. since v0.17.0.
switchQuery :: (HasDesc proxy, MonadIO actM, KnownSymbol k, k </ prms)
            => proxy k -> Filter exts actM m prms (k ':= Bool ': prms)
switchQuery k = focus doc Nothing $ R.raw "switch" $ \d t -> do
    qs      <- getQueryParams
    (ps,fs) <- getReqBodyInternal
    let n = maybe False id . fmap (maybe True id) . lookup (SC.pack $ symbolVal k) $ reqParams (Proxy :: Proxy Bool) qs ps fs

            
src/Control/Monad/Apiary/Filter.hs
--------------------------------------------------------------------------------

-- | filter by header and get first. since 0.6.0.0.
header :: (KnownSymbol k, Monad actM, k </ prms)
       => proxy k -> Filter exts actM m prms (k ':= SC.ByteString ': prms)
header k = focus doc Nothing $ R.raw "header" $ \d t -> do
    n <- maybe mzero return . lookup (CI.mk . SC.pack $ symbolVal k) . Wai.requestHeaders =<< getRequest
    return (Dict.add k n d, t)
  where

            
src/Control/Monad/Apiary/Filter.hs
    doc = DocPrecondition $ "has header: " <> toHtml (symbolVal k)

-- | check whether to exists specified valued header or not. since 0.6.0.0.
eqHeader :: (KnownSymbol k, Monad actM)
         => proxy k -> SC.ByteString -> Filter' exts actM m
eqHeader k v = focus doc Nothing $ R.raw "=header" $ \d t -> do
    v' <- maybe mzero return . lookup (CI.mk . SC.pack $ symbolVal k) . Wai.requestHeaders =<< getRequest
    if v == v' then return (d,t) else mzero
  where

            
src/Control/Monad/Apiary/Filter.hs
    doc = DocPrecondition $ "header: " <> toHtml (symbolVal k) <> " = " <> toHtml (show v)

-- | filter by JSON typed body. since 2.0.0.
jsonReqBody :: (KnownSymbol k, MonadIO actM, k </ prms, FromJSON a)
       => proxy k -> Filter exts actM m prms (k ':= a ': prms)
jsonReqBody k = focus doc Nothing $ R.raw "json body" $ \d t -> do
    n <- maybe mzero return =<< getReqBodyJSON
    return (Dict.add k n d, t)
  where

            
bdcs-api-0.1.3
3 matches
src/BDCS/API/V0.hs
import           Database.Persist.Sql
import           Data.GI.Base(GError(..))
import           Data.UUID.V4(nextRandom)
import           GHC.TypeLits(KnownSymbol)
import qualified GI.Ggit as Git
import           Servant
import           System.Directory(createDirectoryIfMissing)
import           System.FilePath.Posix((</>), takeFileName)


            
src/BDCS/API/V0.hs
--
-- The mime type is set to 'application/x-tar' and the filename is set to
-- UUID-logs.tar
composeLogs :: KnownSymbol h => ServerConfig -> String -> Handler (Headers '[Header h String] LBS.ByteString)
composeLogs serverConf uuid =
    returnResults serverConf uuid (Just "-logs") ["compose.log"]


-- | /api/v0/compose/image/<uuid>

            
src/BDCS/API/V0.hs
--
-- Returns the output image from the build. The filename is set to the filename
-- from the build with the UUID as a prefix. eg. UUID-root.tar.xz or UUID-boot.iso.
composeImage :: KnownSymbol h => ServerConfig -> T.Text -> Handler (Headers '[Header h String] LBS.ByteString)
composeImage serverConf uuid = do
    (fn, contents) <- returnImage serverConf (cs uuid)
    return $ addHeader ("attachment; filename=" ++ filename fn ++ ";") contents
 where
    filename fn = cs uuid ++ "-" ++ takeFileName fn