fclabels 0.4.1 → 0.4.2

raw patch · 5 files changed

+193/−180 lines, 5 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• Data/Record/Label.hs +0/−143
• Data/Record/Label/TH.hs +0/−35
• fclabels.cabal +3/−2
• src/Data/Record/Label.hs +152/−0
• src/Data/Record/Label/TH.hs +38/−0

@@ -1,143 +0,0 @@-{-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-}-module Data.Record.Label-  (-  -- * Getter, setter and modifier types.-    Getter-  , Setter-  , Modifier--  -- * Label type.-  , Point-  , (:->) (Label)-  , label-  , get, set, mod--  -- * Bidirectional functor.-  , (:<->:) (..)-  , (<->)-  , Iso (..)-  , for--  -- * State monadic label operations.--  , getM, setM, modM, (=:)--  -- * Derive labels using Template Haskell.-  , module Data.Record.Label.TH-  )-where--import Prelude hiding ((.), id, mod)-import Control.Applicative-import Control.Category-import Control.Monad.State hiding (get)-import Data.Record.Label.TH--type Getter   f o   = f -> o-type Setter   f i   = i -> f -> f-type Modifier f i o = (o -> i) -> f -> f--data Point f i o = Point-  { _get :: Getter f o-  , _set :: Setter f i-  }--_mod :: Point f i o -> (o -> i) -> f -> f-_mod l f a = _set l (f (_get l a)) a--newtype (f :-> a) = Label { unLabel :: Point f a a }---- Create a label out of a getter and setter.--label :: Getter f a -> Setter f a -> f :-> a-label g s = Label (Point g s)---- | Get the getter function from a label.--get :: (f :-> a) -> f -> a-get = _get . unLabel---- | Get the setter function from a label.--set :: (f :-> a) -> a -> f -> f-set = _set . unLabel---- | Get the modifier function from a label.--mod :: (f :-> a) -> (a -> a) -> f -> f-mod = _mod . unLabel--instance Category (:->) where-  id = Label (Point id const)-  (Label a) . (Label b) = Label (Point (_get a . _get b) (_mod b . _set a))--instance Functor (Point f i) where-  fmap f x = Point (f . _get x) (_set x)--instance Applicative (Point f i) where-  pure a = Point (const a) (const id)-  a <*> b = Point (\f -> _get a f (_get b f)) (\r -> _set b r . _set a r)---- | This isomorphism type class is like a `Functor' but works in two directions.--class Iso f where-  iso :: a :<->: b -> f a -> f b-  iso (Lens a b) = osi (b <-> a)-  osi :: a :<->: b -> f b -> f a-  osi (Lens a b) = iso (b <-> a)---- | The lens datatype, a function that works in two directions. To bad there--- is no convenient way to do application for this.--data a :<->: b = Lens { fw :: a -> b, bw :: b -> a }---- | Constructor for lenses.--infixr 7 <->-(<->) :: (a -> b) -> (b -> a) -> a :<->: b-a <-> b = Lens a b--instance Category (:<->:) where-  id = Lens id id-  (Lens a b) . (Lens c d) = Lens (a . c) (d . b)--instance Iso ((:->) i) where-  iso l (Label a) = Label (Point (fw l . _get a) (_set a . bw l))--instance Iso ((:<->:) i) where-  iso = (.)--dimap :: (o' -> o) -> (i -> i') -> Point f i' o' -> Point f i o-dimap f g l = Point (f . _get l) (_set l . g)---- | Combine a partial destructor with a label into something easily used in--- the applicative instance for the hidden `Point' datatype. Internally uses--- the covariant in getter, contravariant in setter bi-functioral-map function.--- (Please refer to the example because this function is just not explainable--- on its own.)--for :: (i -> o) -> (f :-> o) -> Point f i o-for a b = dimap id a (unLabel b)---- | Get a value out of state pointed to by the specified label.--getM :: MonadState s m => s :-> b -> m b-getM = gets . get---- | Set a value somewhere in state pointed to by the specified label.--setM :: MonadState s m => s :-> b -> b -> m ()-setM l = modify . set l---- | Alias for `setM' that reads like an assignment.--infixr 7 =:-(=:) :: MonadState s m => s :-> b -> b -> m ()-(=:) = setM---- | Modify a value with a function somewhere in state pointed to by the--- specified label.--modM :: MonadState s m => s :-> b -> (b -> b) -> m ()-modM l = modify . mod l-

@@ -1,35 +0,0 @@-module Data.Record.Label.TH (mkLabels) where--import Control.Monad-import Data.Char-import Language.Haskell.TH.Syntax---- | Derive labels for all the record selector in a datatype.-mkLabels :: [Name] -> Q [Dec]-mkLabels = liftM concat . mapM mkLabels1--mkLabels1 :: Name -> Q [Dec]-mkLabels1 n = do-    i <- reify n-    let -- only process data declarations-        cs' = case i of { TyConI (DataD _ _ _ cs _) -> cs ; _ -> [] }-        -- we're only interested in labels of record constructors-        ls' = [ l | RecC _ ls <- cs', l <- ls ]-    return (map mkLabel1 ls')--mkLabel1 :: VarStrictType -> Dec-mkLabel1 (name, _, _) =-    -- Generate a name for the label:-    -- If the original selector starts with an _, remove it and make the next-    -- character lowercase.  Otherwise, add 'l', and make the next character-    -- uppercase.-    let n = mkName $ case nameBase name of-                ('_' : c : rest) -> toLower c : rest-                (f : rest)       -> 'l' : toUpper f : rest-                _                -> ""-    in FunD n [Clause [] (NormalB (-           AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter-                (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter-                      (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))]))-                                   )) []]-

@@ -1,5 +1,5 @@ Name:            fclabels-Version:         0.4.1+Version:         0.4.2 Author:          Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher. Synopsis:        First class accessor labels. @@ -135,7 +135,8 @@ Category:        Data Build-Type:      Simple Cabal-Version:   >= 1.6+HS-Source-Dirs:  src Exposed-Modules: Data.Record.Label Other-Modules:   Data.Record.Label.TH-Build-Depends:   base >= 3 && < 5, template-haskell >= 2.2 && < 2.4, monads-fd ==0.0.*+Build-Depends:   base >= 3 && < 5, template-haskell >= 2.2 && < 2.5, monads-fd ==0.0.* 

@@ -0,0 +1,152 @@+{-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-}+module Data.Record.Label+  (+  -- * Getter, setter and modifier types.+    Getter+  , Setter+  , Modifier++  -- * Label type.+  , Point+  , (:->) (Label)+  , label+  , get, set, mod++  , fmapL++  -- * Bidirectional functor.+  , (:<->:) (..)+  , (<->)+  , Iso (..)+  , lmap+  , for++  -- * State monadic label operations.++  , getM, setM, modM, (=:)++  -- * Derive labels using Template Haskell.+  , module Data.Record.Label.TH+  )+where++import Prelude hiding ((.), id, mod)+import Control.Applicative+import Control.Category+import Control.Monad.State hiding (get)+import Data.Record.Label.TH++type Getter   f o   = f -> o+type Setter   f i   = i -> f -> f+type Modifier f i o = (o -> i) -> f -> f++data Point f i o = Point+  { _get :: Getter f o+  , _set :: Setter f i+  }++_mod :: Point f i o -> (o -> i) -> f -> f+_mod l f a = _set l (f (_get l a)) a++newtype (f :-> a) = Label { unLabel :: Point f a a }++-- Create a label out of a getter and setter.++label :: Getter f a -> Setter f a -> f :-> a+label g s = Label (Point g s)++-- | Get the getter function from a label.++get :: (f :-> a) -> f -> a+get = _get . unLabel++-- | Get the setter function from a label.++set :: (f :-> a) -> a -> f -> f+set = _set . unLabel++-- | Get the modifier function from a label.++mod :: (f :-> a) -> (a -> a) -> f -> f+mod = _mod . unLabel++instance Category (:->) where+  id = Label (Point id const)+  (Label a) . (Label b) = Label (Point (_get a . _get b) (_mod b . _set a))++instance Functor (Point f i) where+  fmap f x = Point (f . _get x) (_set x)++instance Applicative (Point f i) where+  pure a = Point (const a) (const id)+  a <*> b = Point (_get a <*> _get b) (\r -> _set b r . _set a r)++fmapL :: Applicative f => (a :-> b) -> f a :-> f b+fmapL l = label (fmap (get l)) (\x f -> set l <$> x <*> f)++-- | This isomorphism type class is like a `Functor' but works in two directions.++class Iso f where+  iso :: a :<->: b -> f a -> f b+  iso (Lens a b) = osi (b <-> a)+  osi :: a :<->: b -> f b -> f a+  osi (Lens a b) = iso (b <-> a)++-- | The lens datatype, a function that works in two directions. To bad there+-- is no convenient way to do application for this.++data a :<->: b = Lens { fw :: a -> b, bw :: b -> a }++-- | Constructor for lenses.++infixr 7 <->+(<->) :: (a -> b) -> (b -> a) -> a :<->: b+a <-> b = Lens a b++instance Category (:<->:) where+  id = Lens id id+  (Lens a b) . (Lens c d) = Lens (a . c) (d . b)++instance Iso ((:->) i) where+  iso l (Label a) = Label (Point (fw l . _get a) (_set a . bw l))++instance Iso ((:<->:) i) where+  iso = (.)++lmap :: Functor f => (a :<->: b) -> f a :<->: f b +lmap l = let (Lens a b) = l in fmap a <-> fmap b++dimap :: (o' -> o) -> (i -> i') -> Point f i' o' -> Point f i o+dimap f g l = Point (f . _get l) (_set l . g)++-- | Combine a partial destructor with a label into something easily used in+-- the applicative instance for the hidden `Point' datatype. Internally uses+-- the covariant in getter, contravariant in setter bi-functioral-map function.+-- (Please refer to the example because this function is just not explainable+-- on its own.)++for :: (i -> o) -> (f :-> o) -> Point f i o+for a b = dimap id a (unLabel b)++-- | Get a value out of state pointed to by the specified label.++getM :: MonadState s m => s :-> b -> m b+getM = gets . get++-- | Set a value somewhere in state pointed to by the specified label.++setM :: MonadState s m => s :-> b -> b -> m ()+setM l = modify . set l++-- | Alias for `setM' that reads like an assignment.++infixr 7 =:+(=:) :: MonadState s m => s :-> b -> b -> m ()+(=:) = setM++-- | Modify a value with a function somewhere in state pointed to by the+-- specified label.++modM :: MonadState s m => s :-> b -> (b -> b) -> m ()+modM l = modify . mod l+

@@ -0,0 +1,38 @@+module Data.Record.Label.TH (mkLabels) where++import Control.Monad+import Data.Char+import Language.Haskell.TH.Syntax++-- | Derive labels for all the record selector in a datatype.+mkLabels :: [Name] -> Q [Dec]+mkLabels = liftM concat . mapM mkLabels1++mkLabels1 :: Name -> Q [Dec]+mkLabels1 n = do+    i <- reify n+    let -- only process data and newtype declarations+        cs' = case i of+                TyConI (DataD _ _ _ cs _)   -> cs+                TyConI (NewtypeD _ _ _ c _) -> [c]+                _ -> []+        -- we're only interested in labels of record constructors+        ls' = [ l | RecC _ ls <- cs', l <- ls ]+    return (map mkLabel1 ls')++mkLabel1 :: VarStrictType -> Dec+mkLabel1 (name, _, _) =+    -- Generate a name for the label:+    -- If the original selector starts with an _, remove it and make the next+    -- character lowercase.  Otherwise, add 'l', and make the next character+    -- uppercase.+    let n = mkName $ case nameBase name of+                ('_' : c : rest) -> toLower c : rest+                (f : rest)       -> 'l' : toUpper f : rest+                _                -> ""+    in FunD n [Clause [] (NormalB (+           AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter+                (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter+                      (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))]))+                                   )) []]+