packages feed

data-lens-light (empty) → 0.1

raw patch · 7 files changed

+339/−0 lines, 7 filesdep +basedep +mtldep +template-haskellsetup-changed

Dependencies added: base, mtl, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,53 @@+Copyright (c) 2014 Roman Cheplyaka++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++--------------------------------------------------------------------------++Copyright 2008-2012 Edward A. Kmett, Russell O'Connor & Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data-lens-light.cabal view
@@ -0,0 +1,33 @@+-- Initial data-lens-light.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                data-lens-light+version:             0.1+synopsis:            Simple lenses, minimum dependencies+description:         See <https://github.com/feuerbach/data-lens-light/blob/master/README.md>+homepage:            https://github.com/feuerbach/data-lens-light+license:             MIT+license-file:        LICENSE+author:              Roman Cheplyaka+maintainer:          roma@ro-che.info+-- copyright:           +category:            Data+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  ghc-options: -Wall+  exposed-modules:+    Data.Lens.Light+  other-modules:       +    Data.Lens.Light.Core+    Data.Lens.Light.Template+    Data.Lens.Light.State+  -- other-extensions:    +  build-depends:+    base >= 4.5 && < 5,+    template-haskell,+    mtl+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Data/Lens/Light.hs view
@@ -0,0 +1,14 @@+module Data.Lens.Light+  (+    -- * Lenses and basic operations+    module Data.Lens.Light.Core+    -- * Generate lenses using TH+  , module Data.Lens.Light.Template+    -- * MonadState operators+  , module Data.Lens.Light.State+  )+  where++import Data.Lens.Light.Core+import Data.Lens.Light.Template+import Data.Lens.Light.State
+ src/Data/Lens/Light/Core.hs view
@@ -0,0 +1,57 @@+module Data.Lens.Light.Core+  ( Lens(..)+  , lens+  , iso+  , getL+  , setL+  , modL+  , modL'+  , (^.)+  )+  where++import Prelude hiding (id, (.))+import Control.Category++-- | Simple lens data type+newtype Lens a b = Lens { runLens :: a -> (b -> a, b) }++instance Category Lens where+  id = iso id id+  x . y =+    lens+      (getL x . getL y)+      (\b -> modL y $ setL x b)++-- | Build a lens out of a getter and setter+lens :: (a -> b) -> (b -> a -> a) -> Lens a b+lens get set = Lens $ \a -> (flip set a, get a)++-- | Build a lens out of an isomorphism+iso :: (a -> b) -> (b -> a) -> Lens a b+iso f g = lens f (\x _ -> g x)++-- | Get the getter function from a lens+getL :: Lens a b -> a -> b+getL l = snd . runLens l++-- | Get the setter function from a lens+setL :: Lens a b -> b -> a -> a+setL l = flip $ fst . runLens l++-- | Get the modifier function from a lens+modL :: Lens a b -> (b -> b) -> a -> a+modL l f a =+  case runLens l a of+    (setx, x) -> setx (f x)++-- | Get the modifier function from a lens. Forces function application.+modL' :: Lens a b -> (b -> b) -> a -> a+modL' l f a =+  case runLens l a of+    (setx, x) -> setx $! f x++-- | Infix version of 'getL' (with the reverse order of the arguments)+infixl 9 ^.+(^.) :: b -> Lens b c -> c+(^.) = flip getL
+ src/Data/Lens/Light/State.hs view
@@ -0,0 +1,42 @@+module Data.Lens.Light.State+  ( access+  , (~=)+  , (!=)+  , (%=)+  , (!%=)+  )+  where++import Control.Monad.State+import Data.Lens.Light.Core++-- | Get the value of a lens into state+access :: MonadState a m => Lens a b -> m b+access l = gets (getL l)++-- | Set a value using a lens into state+(~=) :: MonadState a m => Lens a b -> b -> m ()+l ~= b = modify $ setL l b++-- | Set a value using a lens into state. Forces both the value and the+-- whole state.+(!=) :: MonadState a m => Lens a b -> b -> m ()+l != b = modify' $ setL l $! b++infixr 4 ~=, !=++-- | Infix modification of a value through a lens into state+(%=) :: MonadState a m => Lens a b -> (b -> b) -> m ()+l %= f = modify $ modL l f++-- | Infix modification of a value through a lens into state. Forces both+-- the function application and the whole state.+(!%=) :: MonadState a m => Lens a b -> (b -> b) -> m ()+l !%= f = modify' $ modL' l f++infixr 4 %=, !%=++modify' :: MonadState s m => (s -> s) -> m ()+modify' f = do+  s <- get+  put $! f s
+ src/Data/Lens/Light/Template.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE TemplateHaskell #-}++{- |+This module provides an automatic Template Haskell+routine to scour data type definitions and generate+accessor objects for them automatically.+-}+module Data.Lens.Light.Template (+   nameMakeLens, makeLenses, makeLens+   ) where++import Language.Haskell.TH.Syntax+import Control.Monad (liftM, when, (<=<))+import Data.Maybe (catMaybes)+import Data.List (nub)+import Data.Lens.Light.Core++-- |@makeLenses n@ where @n@ is the name of a data type+-- declared with @data@ looks through all the declared fields+-- of the data type, and for each field beginning with an underscore+-- generates an accessor of the same name without the underscore.+--+-- It is "nameMakeLens" n f where @f@ satisfies+--+-- > f ('_' : s) = Just s+-- > f x = Nothing -- otherwise+--+-- For example, given the data type:+--+-- > data Score = Score { +-- >   _p1Score :: Int+-- > , _p2Score :: Int+-- > , rounds :: Int+-- > }+--+-- @makeLenses@ will generate the following objects:+--+-- > p1Score :: Lens Score Int+-- > p1Score = lens _p1Score (\x s -> s { _p1Score = x })+-- > p2Score :: Lens Score Int+-- > p2Score = lens _p2Score (\x s -> s { _p2Score = x })+--+-- It is used with Template Haskell syntax like:+--+-- > $( makeLenses [''TypeName] )+--+-- And will generate accessors when TypeName was declared+-- using @data@ or @newtype@.+makeLenses :: [Name] -> Q [Dec]+makeLenses = return . concat <=< mapM makeLens++-- | +-- > makeLens a = makeLenses [a]+--+-- > $( makeLens ''TypeName )++makeLens :: Name -> Q [Dec]+makeLens n = nameMakeLens n stripUnderscore++stripUnderscore :: String -> Maybe String+stripUnderscore [] = Nothing+stripUnderscore s +   | head s == '_' = Just (tail s)+   | otherwise = Nothing++namedFields :: Con -> [VarStrictType]+namedFields (RecC _ fs) = fs+namedFields (ForallC _ _ c) = namedFields c+namedFields _ = []++-- |@nameMakeLens n f@ where @n@ is the name of a data type+-- declared with @data@ and @f@ is a function from names of fields+-- in that data type to the name of the corresponding accessor. If+-- @f@ returns @Nothing@, then no accessor is generated for that+-- field.+nameMakeLens :: Name -> (String -> Maybe String) -> Q [Dec]+nameMakeLens t namer = do+    info <- reify t+    reified <- case info of+                    TyConI dec -> return dec+                    _ -> fail $ errmsg t+    decMakeLens t reified namer++decMakeLens :: Name -> Dec -> (String -> Maybe String) -> Q [Dec]+decMakeLens t dec namer = do+    (params, cons) <- case dec of+                 DataD _ _ params cons' _ -> return (params, cons')+                 NewtypeD _ _ params con' _ -> return (params, [con'])+                 _ -> fail $ errmsg t+    decs <- makeAccs params . nub $ concatMap namedFields cons+    when (null decs) $ qReport False nodefmsg+    return decs++    where++    nodefmsg = "Warning: No accessors generated from the name " ++ show t+          ++ "\n If you are using makeLenses rather than"+          ++ "\n nameMakeLens, remember accessors are"+          ++ "\n only generated for fields starting with an underscore"++    makeAccs :: [TyVarBndr] -> [VarStrictType] -> Q [Dec]+    makeAccs params vars =+        liftM (concat . catMaybes) $ mapM (\ (name,_,ftype) -> makeAccFromName name params ftype) vars++    transformName :: Name -> Maybe Name+    transformName (Name occ _) = do+        n <- namer (occString occ)+        return $ Name (mkOccName n) NameS++    makeAccFromName :: Name -> [TyVarBndr] -> Type -> Q (Maybe [Dec])+    makeAccFromName name params ftype =+        case transformName name of+            Nothing -> return Nothing+            Just n -> liftM Just $ makeAcc name params ftype n++    makeAcc ::Name -> [TyVarBndr] -> Type -> Name -> Q [Dec]+    makeAcc name params ftype accName = do+        let params' = map (\x -> case x of (PlainTV n) -> n; (KindedTV n _) -> n) params+        let appliedT = foldl AppT (ConT t) (map VarT params')+        body <- [|+                 lens+                    ( $( return $ VarE name ) )+                    ( \x s ->+                        $( return $ RecUpdE (VarE 's) [(name, VarE 'x)] ) )+                |]+        return+          [ SigD accName (ForallT (map PlainTV params')+               [] (AppT (AppT (ConT ''Lens) appliedT) ftype))+          , ValD (VarP accName) (NormalB body) []+          ]++errmsg :: Show a => a -> [Char]+errmsg t = "Cannot derive accessors for name " ++ show t ++ " because"+         ++ "\n it is not a type declared with 'data' or 'newtype'"+         ++ "\n Did you remember to double-tick the type as in"+         ++ "\n $(makeLenses ''TheType)?"++