Aelve Codesearch

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

total matches: more than 1000

TrieMap-4.1.0
15 matches
Data/TrieMap/RadixTrie/Edge.hs
      insertEdge,
      isectEdge,
      lookupEdge,
      mapEitherEdge,
      mapMaybeEdge,
      unionEdge,
      fromAscListEdge) where

import Control.Monad.Lookup
import Control.Monad.Ends

            
Data/TrieMap/RadixTrie/Edge.hs
import Data.Vector.Generic (length)
import qualified Data.Vector (Vector)
import qualified Data.Vector.Primitive (Vector)
import Prelude hiding (length, foldr, foldl, zip, take, map)

import GHC.Exts

#define V(f) f (Data.Vector.Vector) (k)
#define U(f) f (Data.Vector.Primitive.Vector) (Word)

            
Data/TrieMap/RadixTrie/Edge.hs
instance Label v k => Functor (Edge v k) where
  {-# SPECIALIZE instance TrieKey k => Functor (V(Edge)) #-}
  {-# SPECIALIZE instance Functor (U(Edge)) #-}
  fmap f = map where
    map EDGE(sz ks v ts) = edge' sz ks (f <$> v) (map <$> ts)

instance Label v k => Foldable (Edge v k) where
  {-# SPECIALIZE instance TrieKey k => Foldable (V(Edge)) #-}
  {-# SPECIALIZE instance Foldable (U(Edge)) #-}
  foldMap f = fold where

            
Data/TrieMap/RadixTrie/Edge.hs
    foldBranch = foldMap fold
    fold e = case eView e of
      Edge _ _ Nothing ts	-> foldBranch ts
      Edge _ _ (Just a) ts	-> f a `mappend` foldBranch ts
  
  foldr f = flip fold where
    foldBranch = foldr fold
    fold e z = case eView e of
      Edge _ _ Nothing ts -> foldBranch z ts

            
Data/TrieMap/RadixTrie/Edge.hs
	  match' e' tHole = searchE ks' e' (deep path ls v tHole)
	  in searchMC kk ts nomatch' match'

{-# SPECIALIZE mapMaybeEdge ::
      (TrieKey k, Sized b) => (a -> Maybe b) -> V(Edge) a -> V(MEdge) b,
      Sized b => (a -> Maybe b) -> U(Edge) a -> U(MEdge) b #-}
mapMaybeEdge :: (Label v k, Sized b) => (a -> Maybe b) -> Edge v k a -> MEdge v k b
mapMaybeEdge f = mapMaybeE where
  mapMaybeE !EDGE(_ ks !v ts) = let !v' = v >>= f in cEdge ks v' (mapMaybe mapMaybeE ts)

{-# SPECIALIZE mapEitherEdge ::
      (TrieKey k, Sized b, Sized c) => (a -> (# Maybe b, Maybe c #)) -> V(Edge) a -> (# V(MEdge) b, V(MEdge) c #),
      (Sized b, Sized c) => (a -> (# Maybe b, Maybe c #)) -> U(Edge) a -> (# U(MEdge) b, U(MEdge) c #) #-}
mapEitherEdge :: (Label v k, Sized b, Sized c) => 
	(a -> (# Maybe b, Maybe c #)) -> Edge v k a -> (# MEdge v k b, MEdge v k c #)
mapEitherEdge f = mapEitherE where
	mapEitherE EDGE(_ ks v ts) = (# cEdge ks vL tsL, cEdge ks vR tsR #)
	  where	!(# vL, vR #) = mapEither f v
		!(# tsL, tsR #) = mapEither mapEitherE ts

{-# INLINE assignEdge #-}
assignEdge :: (Label v k, Sized a) => a -> EdgeLoc v k a -> Edge v k a
assignEdge v LOC(ks ts path) = assign (edge ks (Just v) ts) path


            
Data/TrieMap/RadixTrie/Edge.hs
	nomatch _ = Just eK
	match eK' holeKT = cEdge ks0 vK $ fillHoleM (eK' `diffE` eL') holeKT
      GT -> let k = ks0 !$ lLen; eK' = dropEdge (lLen + 1) eK in 
	runLookup (lookupMC k tsL) (Just eK) (\ eL' -> fmap (unDropEdge (lLen + 1)) (eK' `diffE` eL'))

instance (Eq k, Label v k) => Subset (Edge v k) where
  {-# SPECIALIZE instance (Eq k, TrieKey k) => Subset (V(Edge)) #-}
  {-# SPECIALIZE instance Subset (U(Edge)) #-}
  eK@EDGE(_ ks0 vK tsK) <=? EDGE(_ ls0 vL tsL) = matchSlice matcher matches ks0 ls0 where

            
Data/TrieMap/RadixTrie.hs
#define VINSTANCE(cl) (TrieKey k, cl (TrieMap k)) => cl (TrieMap (Vector k))

instance VINSTANCE(Functor) where
  fmap f (Radix m) = Radix (fmap f <$> m)

instance VINSTANCE(Foldable) where
  foldMap f (Radix m) = foldMap (foldMap f) m
  foldr f z (Radix m) = foldl (foldr f) z m
  foldl f z (Radix m) = foldl (foldl f) z m

            
Data/TrieMap/RadixTrie.hs
  SETOP(Radix,diff,diffEdge)

instance VINSTANCE(Project) where
  mapMaybe f (Radix m) = Radix (mapMaybe (mapMaybeEdge f) m)
  mapEither f (Radix m) = both' Radix Radix (mapEither (mapEitherEdge f)) m

-- | @'TrieMap' ('Vector' k) a@ is a traditional radix trie.
instance TrieKey k => TrieKey (Vector k) where
	newtype TrieMap (Vector k) a = Radix (MEdge Vector k a)
	newtype Hole (Vector k) a = Hole (EdgeLoc Vector k a)

            
Data/TrieMap/RadixTrie.hs
	{-# INLINE assignM #-}
	assignM a (Hole loc) = Radix (Just (assignEdge a loc))
	
	extractHoleM (Radix (Just e)) = fmap Hole <$> extractEdgeLoc e root
	extractHoleM _ = mzero
	
	beforeM (Hole loc) = Radix (beforeEdge Nothing loc)
	beforeWithM a (Hole loc) = Radix (beforeEdge (Just a) loc)
	afterM (Hole loc) = Radix (afterEdge Nothing loc)

            
Data/TrieMap/RadixTrie.hs
#define PINSTANCE(cl) cl (TrieMap (P.Vector Word))

instance PINSTANCE(Functor) where
  fmap f (WRadix m) = WRadix (fmap f <$> m)

instance PINSTANCE(Foldable) where
  foldMap f (WRadix m) = foldMap (foldMap f) m
  foldr f z (WRadix m) = foldl (foldr f) z m
  foldl f z (WRadix m) = foldl (foldl f) z m

            
Data/TrieMap/RadixTrie.hs
  daFold = aFold const

instance PINSTANCE(Project) where
  mapMaybe f (WRadix m) = WRadix (mapMaybe (mapMaybeEdge f) m)
  mapEither f (WRadix m) = both' WRadix WRadix (mapEither (mapEitherEdge f)) m

-- | @'TrieMap' ('P.Vector' Word) a@ is a traditional radix trie specialized for word arrays.
instance TrieKey (P.Vector Word) where
	newtype TrieMap WordVec a = WRadix (MEdge P.Vector Word a)
	newtype Hole WordVec a = WHole (EdgeLoc P.Vector Word a)

            
Data/TrieMap/Representation/Instances/Prim.hs
import Data.Bits
import Data.Vector.Primitive
import qualified Data.Vector.Unboxed as U
import Prelude hiding (map)

#define WDOC(ty) {-| @'Rep' 'ty' = 'Word'@ -}

WDOC(Char)
instance Repr Char where

            
Data/TrieMap/Representation/Instances/Vectors.hs

instance Repr a => Repr (V.Vector a) where
	type Rep (V.Vector a) = V.Vector (Rep a)
	toRep = V.map toRep
	DefList(V.Vector a)

instance Repr (P.Vector Word) where
	type Rep (P.Vector Word) = P.Vector Word
	toRep = id

            
Data/TrieMap/Representation/Instances/Vectors.hs
#define VEC_INT_INST(vec,iTy,wTy)		\
  instance Repr (vec iTy) where {		\
  	type Rep (vec iTy) = Rep (P.Vector wTy);	\
  	toRep xs = (toRep :: P.Vector wTy -> Rep (P.Vector wTy)) (convert (G.map (i2w :: iTy -> wTy) xs)); \
  	DefList(vec iTy)}
#define VEC_INT_INSTANCES(iTy,wTy)	\
	VEC_INT_INST(P.Vector,iTy,wTy); \
	VEC_INT_INST(S.Vector,iTy,wTy); \
	VEC_INT_INST(U.Vector,iTy,wTy)

            
Data/TrieMap/Representation/Instances/Vectors.hs
  instance Repr (vec ty) where {			\
  	type Rep (vec ty) = P.Vector Word;		\
  	{-# INLINE toRep #-};				\
  	toRep xs = convert (G.map (fromIntegral . fromEnum) xs);\
  	DefList(vec ty)}
#define VEC_ENUM_INSTANCES(ty)	\
	VEC_ENUM_INST(ty,P.Vector);	\
	VEC_ENUM_INST(ty,S.Vector);	\
	VEC_ENUM_INST(ty,U.Vector)

            
accelerate-io-1.2.0.0
1 matches
src/Data/Array/Accelerate/IO/Data/Vector/Primitive/Internal.hs
vectorOfUniqueArray :: forall a. Prim a => Int -> UniqueArray a -> Vector a
vectorOfUniqueArray n ua
  = unsafePerformIO
  $ Vector 0 n `fmap` byteArrayOfForeignPtr (n * sizeOf (undefined::a)) (unsafeGetValue (uniqueArrayData ua))


-- Return the ByteArray underlying a ForeignPtr, or a new byte array if it is
-- not a Plain ForeignPtr.
--

            
aeson-1.4.6.0
7 matches
Data/Aeson/Types/FromJSON.hs
    , FromArgs(..)
    , genericParseJSON
    , genericLiftParseJSON
    -- * Classes and types for map keys
    , FromJSONKey(..)
    , FromJSONKeyFunction(..)
    , fromJSONKeyCoerce
    , coerceFromJSONKeyFunction
    , mapFromJSONKeyFunction

            
Data/Aeson/Types/FromJSON.hs
    , FromJSONKeyFunction(..)
    , fromJSONKeyCoerce
    , coerceFromJSONKeyFunction
    , mapFromJSONKeyFunction

    , GFromJSONKey()
    , genericFromJSONKey

    -- * List functions

            
Data/Aeson/Types/FromJSON.hs

import Control.Applicative ((<|>), Const(..), liftA2)
import Control.Monad (zipWithM)
import Data.Aeson.Internal.Functions (mapKey)
import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)
import Data.Aeson.Types.Generic
import Data.Aeson.Types.Internal
import Data.Bits (unsafeShiftR)
import Data.Fixed (Fixed, HasResolution (resolution), Nano)

            
Data/Aeson/Types/FromJSON.hs
-- type is an instance of 'Generic'.
genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))
                 => Options -> Value -> Parser a
genericParseJSON opts = fmap to . gParseJSON opts NoFromArgs

-- | A configurable generic JSON decoder. This function applied to
-- 'defaultOptions' is used as the default for 'liftParseJSON' when the
-- type is an instance of 'Generic1'.
genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))

            
Data/Aeson/Types/FromJSON.hs
genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
                     => Options -> (Value -> Parser a) -> (Value -> Parser [a])
                     -> Value -> Parser (f a)
genericLiftParseJSON opts pj pjl = fmap to1 . gParseJSON opts (From1Args pj pjl)

-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------


            
Data/Aeson/Types/FromJSON.hs
--
-- @
-- customOptions = 'defaultOptions'
--                 { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
--                 }
--
-- instance 'FromJSON' Coord where
--     'parseJSON' = 'genericParseJSON' customOptions
-- @

            
Data/Aeson/Types/FromJSON.hs
        $ a

-------------------------------------------------------------------------------
--  Classes and types for map keys
-------------------------------------------------------------------------------

-- | Read the docs for 'ToJSONKey' first. This class is a conversion
--   in the opposite direction. If you have a newtype wrapper around 'Text',
--   the recommended way to define instances is with generalized newtype deriving:

            
aeson-diff-generic-0.0.3
7 matches
Data/Aeson/Diff/Generic/Instances.hs
instance JsonPatch a => FieldLens (NonEmpty.NonEmpty a) where
  fieldLens key ne = do
    GetSet v f <- fieldLens key (NonEmpty.toList ne)
    pure $ GetSet v (fmap NonEmpty.fromList . f)
  {-# INLINE fieldLens #-}

  insertAt key ne v f =
    NonEmpty.fromList <$> insertAt key (NonEmpty.toList ne) v f
  deleteAt key ne f = do

            
Data/Aeson/Diff/Generic/Instances.hs
instance JsonPatch a => FieldLens (DList.DList a) where
  fieldLens key dl = do
    GetSet v f <- fieldLens key (DList.toList dl)
    pure $ GetSet v (fmap DList.fromList . f)
  {-# INLINE fieldLens #-}

  insertAt key dl v f =
    DList.fromList <$> insertAt key (DList.toList dl) v f
  deleteAt key dl f = 

            
Data/Aeson/Diff/Generic/Instances.hs
  insertAt key dl v f =
    DList.fromList <$> insertAt key (DList.toList dl) v f
  deleteAt key dl f = 
    fmap DList.fromList <$> deleteAt key (DList.toList dl) f
    
      
instance (Ord a, JsonPatch a) => JsonPatch (Set.Set a) 
instance (Ord a, JsonPatch a) => FieldLens (Set.Set a) where
  fieldLens key st = do

            
Data/Aeson/Diff/Generic/Instances.hs
         => JsonPatch (Map.Map k a)
instance (FromJSONKey k, ToJSONKey k, Eq k, Ord k, JsonPatch a, JsonPatch k)
         => FieldLens (Map.Map k a) where
  fieldLens key map1 = do
    k <- getMapKey $ strKey key
    case k of
      Nothing -> do
        i <- intKey key
        when (i < 0 || i >= Map.size map1) $

            
Data/Aeson/Diff/Generic/Instances.hs
    case k of
      Nothing -> do
        i <- intKey key
        when (i < 0 || i >= Map.size map1) $
          Error "Invalid Pointer"
        let val = Map.elemAt i map1
        pure $ GetSet val
           (\(k2, v) -> pure $ Map.insert k2 v $ 
                        Map.deleteAt i map1)
      Just s ->
        case Map.lookup s map1 of
          Nothing -> Error "Invalid Pointer"
          Just val ->
            pure $ GetSet val (\v -> pure $ Map.insert s v map1)
  {-# INLINE fieldLens #-}

  insertAt key map1 val f = do
    k <- getMapKey $ strKey key
    case k of
      Nothing -> do
        if isEndKey key then pure () else do
          i <- intKey key

            
Data/Aeson/Diff/Generic/Instances.hs
      Nothing -> do
        if isEndKey key then pure () else do
          i <- intKey key
          when (i < 0 || i >= Map.size map1) $
            Error "Invalid Pointer"
        (k2, v) <- f val
        pure $ Map.insert k2 v map1
      Just s ->
        (\v -> Map.insert s v map1) <$> f val
        
  deleteAt key map1 f = do
    k <- getMapKey $ strKey key
    case k of
      Nothing -> do
        i <- intKey key
        when (i < 0 || i >= Map.size map1) $

            
Data/Aeson/Diff/Generic/Instances.hs
    case k of
      Nothing -> do
        i <- intKey key
        when (i < 0 || i >= Map.size map1) $
          Error "Invalid Pointer"
        pure (f $ Map.elemAt i map1, Map.deleteAt i map1)
      Just s -> case Map.lookup s map1 of
        Nothing -> Error "Invalid Pointer"
        Just v -> pure (f v, Map.delete s map1)

instance JsonPatch Value where
  getAtPointer ptr val f =
    f <$> Pointer.get ptr val
  deleteAtPointer ptr val f =