Aelve Codesearch

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

total matches: 222

solga-0.1.0.2
2 matches
src/Solga.hs
-- | Match any of a set of path segments.
data OneOfSegs (segs :: [ Symbol ]) next = OneOfSegs { oneOfSegsNext :: next }

instance (KnownSymbol seg, Router next, Router (OneOfSegs segs next)) => Router (OneOfSegs (seg ': segs) next) where
  tryRoute = tryRouteNext $ \(OneOfSegs next) -> (Seg next :: Seg seg next) :<|> (OneOfSegs next :: OneOfSegs segs next)

instance Router next => Router (OneOfSegs '[] next) where
  tryRoute _ = Nothing


            
src/Solga.hs
newtype Method (method :: Symbol) next = Method { methodNext :: next }
  deriving (Eq, Ord, Show)

instance (KnownSymbol method, Router next) => Router (Method method next) where
  tryRoute req = do
    guard (Char8.unpack (Wai.requestMethod req) == symbolVal (Proxy :: Proxy method))
    tryRouteNext methodNext req

-- | Return a given JSON object

            
superrecord-0.5.0.1
14 matches
bench/Bench.hs
    & rnil


deriving instance (KnownSymbol a, Read b) => Read ((L.:=) a b )

r1L ::
    ( "f1" L.:= String
    , "f2" L.:= Int
    , "f3" L.:= Bool

            
src/SuperRecord/Variant/Tagged.hs
instance ToJSON (JsonTaggedVariant '[]) where
    toJSON _ = toJSON ()

instance (KnownSymbol lbl, ToJSON t, ToJSON (JsonTaggedVariant ts)) => ToJSON (JsonTaggedVariant (lbl := t ': ts)) where
    toJSON (JsonTaggedVariant v1) =
        let w1 :: Maybe t
            w1 = fromTaggedVariant (FldProxy :: FldProxy lbl) v1
            tag = T.pack $ symbolVal (FldProxy :: FldProxy lbl)
        in let val =

            
src/SuperRecord/Variant/Tagged.hs
           pure $ JsonTaggedVariant emptyVariant

instance ( FromJSON t, FromJSON (JsonTaggedVariant ts)
         , KnownSymbol lbl
         ) => FromJSON (JsonTaggedVariant (lbl := t ': ts)) where
    parseJSON r =
        do let tag = T.pack $ symbolVal (FldProxy :: FldProxy lbl)
               myParser :: Parser t
               myParser = withObject ("Tagged " ++ show tag) (\o -> o .: tag) r

            
src/SuperRecord/Variant/Tagged.hs
-- > toTaggedVariant #myTag "myValue"
toTaggedVariant ::
    forall opts lbl a pos.
    ( KnownSymbol lbl, VariantMember (lbl := a) opts
    , KnownNat pos, VariantPos (lbl := a) opts ~ pos
    )
    => FldProxy lbl -> a -> TaggedVariant opts
toTaggedVariant proxy value = toVariant (proxy := value)


            
src/SuperRecord/Variant/Tagged.hs
-- if the variant is not of the right tag and type.
fromTaggedVariant ::
    forall opts lbl a pos.
    ( KnownSymbol lbl, VariantMember (lbl := a) opts
    , KnownNat pos, VariantPos (lbl := a) opts ~ pos
    )
    => FldProxy lbl -> TaggedVariant opts -> Maybe a
fromTaggedVariant _ variant =
    let loader :: Maybe (lbl := a)

            
src/SuperRecord/Variant/Text.hs
-- OverloadedLabels for nice syntax: @toTextVariant #myString@
toTextVariant ::
    forall opts lbl.
    (KnownSymbol lbl, TextVariantMember lbl opts)
    => FldProxy lbl -> TextVariant opts
toTextVariant proxy =
    TextVariant (T.pack $ symbolVal proxy)

-- | An empty 'TextVariant', equivalent to `()`

            
src/SuperRecord/Variant/Text.hs
class TextVariantMatcher r opts where
   textVariantMatch :: TextVariant opts -> TextVariantMatch r opts -> r

instance (KnownSymbol lbl, TextVariantMatcher r ts) => TextVariantMatcher r (lbl ': ts) where
   textVariantMatch v@(TextVariant tag) match =
     case match of
       TextVariantCase proxy@(FldProxy :: FldProxy lbl) r continue ->
          if T.pack (symbolVal proxy) == tag
          then r

            
src/SuperRecord/Variant/Text.hs
class TextVariantBuilder opts where
   buildTextVariant :: T.Text -> Maybe (TextVariant opts)

instance (KnownSymbol lbl, TextVariantBuilder ts)
    => TextVariantBuilder (lbl ': ts) where
   buildTextVariant text =
     let tag = T.pack (symbolVal (FldProxy :: FldProxy lbl))
     in if tag == text
        then Just (TextVariant tag)

            
src/SuperRecord.hs
   , KnownNat (RecSize lts)
   , KnownNat (RecVecIdxPos l lts)
#ifdef JS_RECORD
   , KnownSymbol l, FromJSVal v, ToJSVal v
#endif
   )

-- | Get an existing record field
get ::

            
src/SuperRecord.hs

data RecFields (flds :: [Symbol]) where
    RFNil :: RecFields '[]
    RFCons :: KnownSymbol f => FldProxy f -> RecFields xs -> RecFields (f ': xs)

recKeys :: forall t (lts :: [*]). RecKeys lts => t lts -> [String]
recKeys = recKeys' . recFields

recKeys' :: RecFields lts -> [String]

            
src/SuperRecord.hs
    type RecKeysT '[] = '[]
    recFields _ = RFNil

instance (KnownSymbol l, RecKeys lts) => RecKeys (l := t ': lts) where
    type RecKeysT (l := t ': lts) = (l ': RecKeysT lts)
    recFields (_ :: f (l := t ': lts)) =
        let lbl :: FldProxy l
            lbl = FldProxy
            more :: Proxy lts

            
src/SuperRecord.hs
    recApply _ _ _ b = b

instance
    ( KnownSymbol l
    , RecApply rts (RemoveAccessTo l lts) c
    , Has l rts v
    , c v
    ) => RecApply rts (l := t ': lts) c where
    recApply f r (_ :: Proxy (l := t ': lts)) b =

            
src/SuperRecord.hs
    recJsonParse initSize _ = pure (unsafeRnil initSize)

instance
    ( KnownSymbol l, FromJSON t, RecJsonParse lts
    , RecSize lts ~ s, KnownNat s, KeyDoesNotExist l lts
#ifdef JS_RECORD
    , ToJSVal t
#endif
    ) => RecJsonParse (l := t ': lts) where

            
src/SuperRecord.hs
    fromNative' (M1 xs) = fromNative' xs

instance
    ( KnownSymbol name
#ifdef JS_RECORD
    , ToJSVal t
#endif
    )
    => FromNative (S1 ('MetaSel ('Just name) p s l) (Rec0 t)) '[name := t]

            
tyro-0.3.0.0
3 matches
src/Data/Tyro.hs
import qualified Data.ByteString.Lazy as B
import           Data.Reflection (reifySymbol)
import           Data.Singletons (Sing, SingI(..))
import           Data.Singletons.TypeLits ( Symbol, SSymbol, KnownSymbol
                                          , withKnownSymbol, symbolVal )
import           Data.String (String)
import           Data.Text (pack)
import           Data.Vector (Vector)
import qualified Data.Vector as V


            
src/Data/Tyro.hs
      B.ByteString -> TyroProxy xs -> Maybe (JSBranch xs a)
    parse b _ = A.decode b

    extend :: (KnownSymbol s) => TyroProxy xs -> Proxy s -> TyroProxy ('JSKey s xs)
    extend t _ = Key t

    dumbUnwrap :: JSBranch xs a -> a
    dumbUnwrap (JSNil x) = x
    dumbUnwrap (JSCons x') = dumbUnwrap x'

            
src/Data/Tyro.hs

-- | 'reflectSym' reflects a type level symbol into a value level string
reflectSymbol :: SSymbol s -> String
reflectSymbol s = withKnownSymbol s $ proxySym s Proxy
  where
    proxySym :: (KnownSymbol n) => SSymbol n -> Proxy n -> String
    proxySym _ = symbolVal



--------------------------------------------------------------------------------

            
vinyl-json-0.1.0.0
1 matches
Data/Vinyl/JSON.hs
    parseJSON (Object v) = pure RNil
    parseJSON _ = mzero

instance (KnownSymbol sym, FromJSON a, FromJSON (PlainRec fields)) =>
        FromJSON (PlainRec ((sym ::: a) ': (fields :: [*]))) where
    parseJSON (Object v) = ((<+>) :: PlainRec '[sym ::: a] 
                                  -> PlainRec fields 
                                  -> PlainRec  ((sym ::: a) ': fields))
                                <$> ((field =:) <$> (v .: json_name))

            
yam-web-0.3.3
1 matches
src/Yam/Web/Swagger.hs
    then reifyGroup conf $ \p -> mkServe' (swagger conf p proxy) p proxy pcxt cxt pc c middlewares server
    else mkServe proxy pcxt cxt pc c middlewares server

reifyGroup :: SwaggerConfig -> (forall d s. (KnownSymbol d ,KnownSymbol s)=> Proxy (SwaggerSchemaUI d s :<|> api) -> r) -> r
reifyGroup SwaggerConfig{..} f = reifySymbol uiPath $ \pd -> reifySymbol apiPath $ \ps -> f $ group pd ps

group :: Proxy dir -> Proxy schema -> Proxy (SwaggerSchemaUI dir schema :<|> api)
group _ _ = Proxy