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 +5/−0
- examples/eff.hs +23/−0
- examples/effect.hs +2/−1
- examples/getopt.hs +1/−1
- examples/state.hs +3/−3
- examples/tangle.hs +2/−2
- extensible.cabal +1/−1
- src/Data/Extensible.hs +1/−1
- src/Data/Extensible/Bits.hs +14/−1
- src/Data/Extensible/Class.hs +3/−1
- src/Data/Extensible/Dictionary.hs +18/−6
- src/Data/Extensible/Effect.hs +1/−1
- src/Data/Extensible/Effect/Default.hs +3/−1
- src/Data/Extensible/Field.hs +3/−3
- src/Data/Extensible/GetOpt.hs +5/−1
- src/Data/Extensible/HList.hs +1/−1
- src/Data/Extensible/Inclusion.hs +2/−1
- src/Data/Extensible/Internal.hs +9/−2
- src/Data/Extensible/Internal/Rig.hs +4/−1
- src/Data/Extensible/Label.hs +1/−1
- src/Data/Extensible/Match.hs +1/−1
- src/Data/Extensible/Nullable.hs +1/−1
- src/Data/Extensible/Plain.hs +1/−1
- src/Data/Extensible/Product.hs +4/−1
- src/Data/Extensible/Record.hs +1/−1
- src/Data/Extensible/Struct.hs +7/−1
- src/Data/Extensible/Sum.hs +1/−1
- src/Data/Extensible/TH.hs +3/−1
- src/Data/Extensible/Tangle.hs +9/−2
- src/Data/Extensible/Wrapper.hs +1/−1
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>