packages feed

extensible 0.4.7.2 → 0.4.8

raw patch · 30 files changed

+131/−40 lines, 30 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.Extensible.Class: getMemberId :: Membership xs x -> Int
+ Data.Extensible.Dictionary: instance forall v (h :: v -> *) (xs :: [Data.Extensible.Internal.Assoc GHC.Types.Symbol v]). Data.Extensible.Class.Forall (Data.Extensible.Field.KeyValue GHC.TypeLits.KnownSymbol (Data.Extensible.Dictionary.Instance1 Data.Aeson.Types.FromJSON.FromJSON h)) xs => Data.Aeson.Types.FromJSON.FromJSON (Data.Extensible.Nullable.Nullable (Data.Extensible.Field.Field h) Data.Extensible.Struct.:* xs)
+ Data.Extensible.Dictionary: instance forall v (h :: v -> *) (xs :: [Data.Extensible.Internal.Assoc GHC.Types.Symbol v]). Data.Extensible.Class.Forall (Data.Extensible.Field.KeyValue GHC.TypeLits.KnownSymbol (Data.Extensible.Dictionary.Instance1 Data.Aeson.Types.ToJSON.ToJSON h)) xs => Data.Aeson.Types.ToJSON.ToJSON (Data.Extensible.Nullable.Nullable (Data.Extensible.Field.Field h) Data.Extensible.Struct.:* xs)

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+0.4.8+-------------------------------------------------+* Changed the `FromJSON` instance for `Record` to call `parseJSON Null` for missing fields+* Added `FromJSON` and `ToJSON` instances for `Nullable (Field h) :* xs`+ 0.4.7.2 ------------------------------------------------- * Added cassava's `ToNamedRecord`, `ToRecord`, `FromNamedRecord` and `FromRecord` instances
+ examples/eff.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TypeApplications, OverloadedLabels, PolyKinds, DataKinds, ScopedTypeVariables, Rank2Types #-}+import Data.Extensible++import Prelude hiding (readFile)+import Control.Exception+import Data.ByteString (ByteString)++data FileSystem r where+  ReadFile+    :: FilePath+    -> FileSystem (Either SomeException ByteString)++readFile+  :: forall xs+  . (Associate "fs" FileSystem xs+  , Associate "fs_error" (EitherEff SomeException) xs)+  => FilePath+  -> Eff xs ByteString+readFile fp = liftEff #fs (ReadFile fp)+           >>= either (throwEff #fs_error) pure++foo :: forall xs. Associate "fs" FileSystem xs => Eff xs (Either SomeException ByteString)+foo = castEff (runEitherEff @ "fs_error" (readFile "foo") :: Eff '["fs" >: FileSystem] (Either SomeException ByteString))
examples/effect.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TemplateHaskell, DataKinds, FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell, DataKinds, TypeOperators, PolyKinds, FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints#-} import Data.Extensible import Control.Monad.IO.Class import Control.Monad.Trans.Writer.Strict
examples/getopt.hs view
@@ -4,7 +4,7 @@ import Data.Extensible.GetOpt  main :: IO ()-main = withGetOpt opts $ \r _args -> do+main = withGetOpt "" opts $ \r _args -> do   putStrLn $ "verbose: " ++ show (r ^. #verbose > 0)   putStrLn $ "extra: " ++ show (r ^? #extra. folded)   where
examples/state.hs view
@@ -1,15 +1,15 @@ {-# LANGUAGE TypeOperators, DataKinds, TemplateHaskell, FlexibleContexts #-} import Data.Extensible import Control.Lens-import Control.Monad.State+import Control.Monad.State.Strict  mkField "foo bar baz" -statefulStuff :: State (Record '["foo" :> Int, "bar" :> Int, "baz" :> Float]) ()+statefulStuff :: State (Record '["foo" >: Int, "bar" >: Int, "baz" >: Float]) () statefulStuff = do     v <- use foo     bar += v     baz .= 42  main = print $ execState statefulStuff-  $ foo @= 10 <: bar @= 0 <: baz @= 0 <: Nil+  $ foo @= 10 <: bar @= 0 <: baz @= 0 <: nil
examples/tangle.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, DataKinds #-}+{-# LANGUAGE TypeOperators, PolyKinds, FlexibleContexts, FlexibleInstances, TemplateHaskell, DataKinds #-} import Control.Monad.Trans.Class import Data.Extensible import Data.Functor.Identity@@ -30,4 +30,4 @@ makeRec = runTangles   (htabulateFor (Proxy :: Proxy MakeRec)     $ \m -> Comp $ Field . pure <$> make m)-  (wrench Nil)+  (wrench nil)
extensible.cabal view
@@ -1,5 +1,5 @@ name:                extensible-version:             0.4.7.2+version:             0.4.8 synopsis:            Extensible, efficient, optics-friendly data types and effects homepage:            https://github.com/fumieval/extensible bug-reports:         http://github.com/fumieval/extensible/issues
src/Data/Extensible.hs view
@@ -1,7 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Bits.hs view
@@ -1,6 +1,15 @@ {-# LANGUAGE UndecidableInstances, ScopedTypeVariables, MultiParamTypeClasses, TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}-+-----------------------------------------------------------------------+-- |+-- Module      :  Data.Extensible.Bits+-- Copyright   :  (c) Fumiaki Kinoshita 2018+-- License     :  BSD3+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+--+-- Bit-packed records+----------------------------------------------------------------------- module Data.Extensible.Bits (BitProd(..)   , FromBits(..)   , TotalBits@@ -40,6 +49,7 @@   showsPrec d x = showParen (d > 10)     $ showString "toBitProd " . showsPrec 11 (fromBitProd x) +-- | Total 'BitWidth' type family TotalBits h xs where   TotalBits h '[] = 0   TotalBits h (x ': xs) = BitWidth (h x) + TotalBits h xs@@ -187,7 +197,10 @@ proxyBitWidth :: Proxy h -> proxy x -> Proxy (BitWidth (h x)) proxyBitWidth _ _ = Proxy +-- | Bit-packed record type BitRecordOf r h = BitProd r (Field h)++-- | Bit-packed record type BitRecord r = BitRecordOf r Identity  instance (Corepresentable p, Comonad (Corep p), Functor f) => Extensible f p (BitProd r) where
src/Data/Extensible/Class.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Class--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -22,6 +22,7 @@   -- * Membership   , Membership   , mkMembership+  , getMemberId   , compareMembership   , leadership   -- * Member@@ -138,6 +139,7 @@    hgenerateListFor p f = HCons <$> f here <*> hgenerateListFor p (f . navNext) +-- | HACK: Without this, the constraints are not propagated well. type family ForallF (c :: k -> Constraint) (xs :: [k]) :: Constraint where   ForallF c '[] = ()   ForallF c (x ': xs) = (c x, Forall c xs)
src/Data/Extensible/Dictionary.hs view
@@ -3,12 +3,11 @@ #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE UndecidableSuperClasses #-} #endif- {-# OPTIONS_GHC -fno-warn-orphans #-} --------------------------------------------------------------------------+-- | -- Module      :  Data.Extensible.Dictionary--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -27,6 +26,7 @@ import Data.Extensible.Sum import Data.Extensible.Internal import Data.Extensible.Internal.Rig+import Data.Extensible.Nullable import Data.Constraint import Data.Extensible.Struct import Data.Extensible.Wrapper@@ -170,17 +170,29 @@     (\k m v -> HM.insert (BC.pack (symbolVal (proxyAssocKey k))) (Csv.toField v) m)     HM.empty +-- | @'parseJSON' 'J.Null'@ is called for missing fields. instance Forall (KeyValue KnownSymbol (Instance1 J.FromJSON h)) xs => J.FromJSON (Field h :* xs) where   parseJSON = J.withObject "Object" $ \v -> hgenerateFor     (Proxy :: Proxy (KeyValue KnownSymbol (Instance1 J.FromJSON h)))-    $ \m -> let k = symbolVal (proxyAssocKey m) in case HM.lookup (T.pack k) v of-      Just a -> Field <$> J.parseJSON a-      Nothing -> fail $ "Missing key: " ++ k+    $ \m -> let k = symbolVal (proxyAssocKey m)+      in fmap Field $ J.parseJSON $ maybe J.Null id $ HM.lookup (T.pack k) v  instance Forall (KeyValue KnownSymbol (Instance1 J.ToJSON h)) xs => J.ToJSON (Field h :* xs) where   toJSON = J.Object . hfoldlWithIndexFor     (Proxy :: Proxy (KeyValue KnownSymbol (Instance1 J.ToJSON h)))     (\k m v -> HM.insert (T.pack (symbolVal (proxyAssocKey k))) (J.toJSON v) m)+    HM.empty++instance Forall (KeyValue KnownSymbol (Instance1 J.FromJSON h)) xs => J.FromJSON (Nullable (Field h) :* xs) where+  parseJSON = J.withObject "Object" $ \v -> hgenerateFor+    (Proxy :: Proxy (KeyValue KnownSymbol (Instance1 J.FromJSON h)))+    $ \m -> let k = symbolVal (proxyAssocKey m)+      in fmap Nullable $ traverse J.parseJSON $ HM.lookup (T.pack k) v++instance Forall (KeyValue KnownSymbol (Instance1 J.ToJSON h)) xs => J.ToJSON (Nullable (Field h) :* xs) where+  toJSON = J.Object . hfoldlWithIndexFor+    (Proxy :: Proxy (KeyValue KnownSymbol (Instance1 J.ToJSON h)))+    (\k m (Nullable v) -> maybe id (HM.insert (T.pack $ symbolVal $ proxyAssocKey k) . J.toJSON) v m)     HM.empty  instance WrapForall Show h xs => Show (h :| xs) where
src/Data/Extensible/Effect.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Effect--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Effect/Default.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Effect.Default--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -119,6 +119,7 @@ execWriterDef = execWriterEff {-# INLINE execWriterDef #-} +-- | Same as @'EitherDef' ()@ type MaybeDef = "Either" >: EitherEff ()  -- | Similar to 'runMaybeT', but on 'Eff'@@ -126,6 +127,7 @@ runMaybeDef = runMaybeEff {-# INLINE runMaybeDef #-} +-- | mtl-compatible either effect type EitherDef e = "Either" >: EitherEff e  -- | Similar to 'runExceptT', but on 'Eff'
src/Data/Extensible/Field.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Field--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -98,12 +98,12 @@  instance (pk k, pv v) => KeyValue pk pv (k ':> v) --- | Combined constraint for 'Assoc'+-- | Constraint applied to 'AssocKey' class (pk (AssocKey kv)) => KeyIs pk kv where  instance (pk k) => KeyIs pk (k ':> v) --- | Combined constraint for 'Assoc'+-- | Constraint applied to 'AssocValue' class (pv (AssocValue kv)) => ValueIs pv kv where  instance (pv v) => ValueIs pv (k ':> v)
src/Data/Extensible/GetOpt.hs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.GetOpt--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -56,6 +56,7 @@ extendArg f (ReqArg a ph) = ReqArg (\s -> f (Just s) (a s)) ph extendArg f (OptArg a ph) = OptArg (f <*> a) ph +-- | Simple option descriptor type OptDescr' = OptionDescr Identity  instance Wrapper (OptionDescr h) where@@ -76,6 +77,7 @@     -> OptDescr' Bool optFlag = optionNoArg (pure . (>0)) +-- | Wrapper-generic version of `optNoArg` optionNoArg :: (Int -> h a) -> [Char] -> [String] -> String -> OptionDescr h a optionNoArg f ss ls expl = OptionDescr f 0 $ Option ss ls (NoArg (+1)) expl @@ -95,9 +97,11 @@     -> OptDescr' (Maybe String) optLastArg ss ls ph expl = OptionDescr pure Nothing $ Option ss ls (ReqArg (const . Just) ph) expl +-- | Wrapper-generic version of `optReqArg` optionReqArg :: ([String] -> h a) -> [Char] -> [String] -> String -> String -> OptionDescr h a optionReqArg f ss ls ph expl = OptionDescr f [] $ Option ss ls (ReqArg (:) ph) expl +-- | Construct an option with an optional argument optionOptArg :: ([Maybe String] -> h a) -> [Char] -> [String] -> String -> String -> OptionDescr h a optionOptArg f ss ls ph expl = OptionDescr f [] $ Option ss ls (OptArg (:) ph) expl 
src/Data/Extensible/HList.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.HList--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Inclusion.hs view
@@ -8,7 +8,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Inclusion--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -28,6 +28,7 @@   -- * Key-value   , IncludeAssoc   , Associated+  , Associated'   , inclusionAssoc   , shrinkAssoc   , spreadAssoc
src/Data/Extensible/Internal.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Inclusion--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -80,7 +80,9 @@     $ conT ''Membership `appT` pure t `appT` varT (names !! n)  -- | The position of @x@ in the type level set @xs@.-newtype Membership (xs :: [k]) (x :: k) = Membership { getMemberId :: Int } deriving (Typeable, NFData)+newtype Membership (xs :: [k]) (x :: k) = Membership+  { getMemberId :: Int -- ^ get the position as an 'Int'.+  } deriving (Typeable, NFData)  newtype Remembrance xs x r = Remembrance (Member xs x => r) @@ -100,6 +102,7 @@ instance Hashable (Membership xs x) where   hashWithSalt s = hashWithSalt s . getMemberId +-- | Make up a 'Membership' from an integer. reifyMembership :: Int -> (forall x. Membership xs x -> r) -> r reifyMembership n k = k (Membership n) @@ -121,11 +124,13 @@ -- | A readable type search result data Elaborated k v = Expecting v | Missing k | Duplicate k +-- | Make the result more readable type family Elaborate (key :: k) (xs :: [v]) :: Elaborated k v where   Elaborate k '[] = 'Missing k   Elaborate k '[x] = 'Expecting x   Elaborate k xs = 'Duplicate k +-- | Find a type associated to the specified key. type family FindAssoc (n :: Nat) (key :: k) (xs :: [Assoc k v]) where   FindAssoc n k ((k ':> v) ': xs) = (n ':> v) ': FindAssoc (1 + n) k xs   FindAssoc n k ((k' ':> v) ': xs) = FindAssoc (1 + n) k xs@@ -173,6 +178,7 @@ -- | Unicode flipped alias for 'Member' type x ∈ xs = Member xs x +-- | First element type family Head (xs :: [k]) :: k where   Head (x ': xs) = x @@ -182,6 +188,7 @@   FindType x (y ': ys) = MapSucc (FindType x ys)   FindType x '[] = '[] +-- | Last element type family Last (x :: [k]) :: k where   Last '[x] = x   Last (x ': xs) = Last xs
src/Data/Extensible/Internal/Rig.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Internal.Rig--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -44,17 +44,20 @@ over = coerce {-# INLINE over #-} +-- | Reifies the structure of 'Iso's data Exchange a b s t = Exchange (s -> a) (b -> t)  instance Profunctor (Exchange a b) where   dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)   {-# INLINE dimap #-} +-- | Recover tho functions from an Iso/ withIso :: Optic (Exchange a b) Identity s t a b -> ((s -> a) -> (b -> t) -> r) -> r withIso l r = case l (Exchange id Identity) of   Exchange f g -> r f (coerce g) {-# INLINE withIso #-} +-- | @'review' :: AReview s a -> a -> s@ review :: Optic' Tagged Identity s a -> a -> s review = coerce {-# INLINE review #-}
src/Data/Extensible/Label.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Label--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Match.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.League--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Nullable.hs view
@@ -2,7 +2,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Nullable--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Plain.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Plain--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Product.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Product--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -136,6 +136,7 @@ hfoldMapWithIndex f = hfoldrWithIndex (\i -> mappend . f i) mempty {-# INLINE hfoldMapWithIndex #-} +-- | Perform a strict left fold over the elements. hfoldlWithIndex :: (forall x. Membership xs x -> r -> h x -> r) -> r -> h :* xs -> r hfoldlWithIndex f r xs = hfoldrWithIndex (\i x c a -> c $! f i a x) id xs r {-# INLINE hfoldlWithIndex #-}@@ -146,6 +147,7 @@ hfoldrWithIndexFor p f r xs = henumerateFor p xs (\i -> f i (hlookup i xs)) r {-# INLINE hfoldrWithIndexFor #-} +-- | Constrained 'hfoldlWithIndex' hfoldlWithIndexFor :: (Forall c xs) => proxy c   -> (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> h :* xs -> r hfoldlWithIndexFor p f r xs = hfoldrWithIndexFor p (\i x c a -> c $! f i a x) id xs r@@ -157,6 +159,7 @@ hfoldMapWithIndexFor p f = hfoldrWithIndexFor p (\i -> mappend . f i) mempty {-# INLINE hfoldMapWithIndexFor #-} +-- | Constrained 'hfoldMap' hfoldMapFor :: (Forall c xs, Monoid a) => proxy c   -> (forall x. c x => h x -> a) -> h :* xs -> a hfoldMapFor p f = hfoldMapWithIndexFor p (const f)
src/Data/Extensible/Record.hs view
@@ -2,7 +2,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Record--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/Struct.hs view
@@ -7,7 +7,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Struct--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -78,6 +78,7 @@ get (Struct m) (getMemberId -> I# i) = primitive $ unsafeCoerce# readSmallArray# m i {-# INLINE get #-} +-- | Atomically modify an element in a 'Struct'. atomicModify :: PrimMonad m   => Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a atomicModify (Struct m) (getMemberId -> I# i) f = primitive@@ -91,6 +92,7 @@           _ -> retry y s' {-# INLINE atomicModify #-} +-- | Strict version of 'atomicModify'. atomicModify' :: PrimMonad m   => Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a atomicModify' s i f = atomicModify s i@@ -98,6 +100,7 @@   >>= (return $!) {-# INLINE atomicModify' #-} +-- | Apply a function to an element atomically. atomicModify_ :: PrimMonad m   => Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x) atomicModify_ (Struct m) (getMemberId -> I# i) f = primitive@@ -110,6 +113,7 @@         _ -> retry y s' {-# INLINE atomicModify_ #-} +-- | Strict version of 'atomicModify_'. atomicModify'_ :: PrimMonad m   => Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x) atomicModify'_ s i f = atomicModify_ s i f >>= (return $!)@@ -217,6 +221,7 @@ hlength (HProduct ar) = I# (sizeofSmallArray# ar) {-# INLINE hlength #-} +-- | Concatenate type level lists type family (++) (xs :: [k]) (ys :: [k]) :: [k] where   '[] ++ ys = ys   (x ': xs) ++ ys = x ': xs ++ ys@@ -298,6 +303,7 @@ hfrozen m = runST $ m >>= unsafeFreeze {-# INLINE[0] hfrozen #-} +-- | Turn a product into a 'Struct' temporarily. hmodify :: (forall s. Struct s h xs -> ST s ()) -> h :* xs -> h :* xs hmodify f m = runST $ do   s <- thaw m
src/Data/Extensible/Sum.hs view
@@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Sum--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
src/Data/Extensible/TH.hs view
@@ -2,7 +2,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.TH--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -44,6 +44,7 @@   let name = mkName $ if isLower x then x : xs else '_' : x : xs   in mkFieldAs name s +-- | @'mkFieldAs' (mkName "foo") "bar"@ defines a field for "bar" as @foo@. mkFieldAs :: Name -> String -> DecsQ mkFieldAs name s = do   let st = litT (strTyLit s)@@ -86,6 +87,7 @@ decEffectSuite :: DecsQ -> DecsQ decEffectSuite = customDecEffects True True +-- | Generate effect suite with custom settings. customDecEffects :: Bool -- ^ generate a synonym of the set of actions     -> Bool -- ^ generate synonyms for individual actions     -> DecsQ -> DecsQ
src/Data/Extensible/Tangle.hs view
@@ -2,14 +2,21 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Struct--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com> -- -- Extensible tangles -------------------------------------------------------------------------module Data.Extensible.Tangle where+module Data.Extensible.Tangle+  ( TangleT(..)+  , lasso+  , hitchAt+  , runTangleT+  , evalTangleT+  , runTangles+  ) where  import Control.Applicative import Control.Monad.Trans.RWS.Strict
src/Data/Extensible/Wrapper.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Wrapper--- Copyright   :  (c) Fumiaki Kinoshita 2017+-- Copyright   :  (c) Fumiaki Kinoshita 2018 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>