packages feed

references 0.3.0.0 → 0.3.0.1

raw patch · 19 files changed

+1002/−552 lines, 19 filesdep +HUnitdep +lensdep +uniplatedep ~arraydep ~basedep ~containerssetup-changed

Dependencies added: HUnit, lens, uniplate

Dependency ranges changed: array, base, containers, directory, either, filepath, instance-control, mtl, template-haskell, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,16 @@+
+Version 0.2.0.0:
+
+ * Exact reference types are now bound by operators.
+ 
+ * New system of operators
+ 
+ * Standardized generic and strict reference types (Lens, Partial, ...).
+ 
+ * New predefined references.
+ 
+Version 0.3.0.0:
+
+ * New, simpler operator interface
+ 
+ * Instead of using Template Haskell, a new type-level calculation based method is used for generating transitive type instances.
+ Control/Reference/Combinators.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts #-}
+
+-- | Operators to combine and transform references.
+module Control.Reference.Combinators where
+
+import Control.Reference.Representation
+import Control.Instances.Morph
+import Control.Monad
+import Control.Monad.Identity
+import Control.Applicative
+
+-- * Binary operators on references
+
+-- | Composes two references. They must be of the same kind.
+--
+-- If reference @r@ accesses @b@ inside the context @a@, and reference @p@ accesses @c@ inside the context @b@,
+-- than the reference @r&p@ will access @c@ inside @a@.
+--
+-- Composition is associative: @ (r&p)&q = r&(p&q) @
+(&) :: (Monad w, Monad r) => Reference w r w' r' s t c d -> Reference w r w' r' c d a b
+    -> Reference w r w' r' s t a b
+(&) l1 l2 = Reference (refGet l1 . refGet l2) 
+                      (refUpdate l1 . refSet l2) 
+                      (refUpdate l1 . refUpdate l2)
+                      (refGet' l2 . refGet' l1)
+                      (refUpdate' l2 . refSet' l1) 
+                      (refUpdate' l2 . refUpdate' l1)
+infixl 6 &
+
+-- | Adds two references.
+--
+-- Using this operator may result in accessing the same parts of data multiple times.
+-- For example @ twice = self &+& self @ is a reference that accesses itself twice:
+--
+-- > a ^? twice == [a,a]
+-- > (twice *= x) a == x
+-- > (twice .- f) a == f (f a)
+--
+-- Addition is commutative only if we do not consider the order of the results from a get,
+-- or the order in which monadic actions are performed.
+--
+(&+&) :: (RefMonads w r, RefMonads w' r', MonadPlus r, MonadPlus r', Morph [] r)
+         => Reference w r w' r' s s a a -> Reference w r w' r' s s a a
+         -> Reference w r w' r' s s a a
+l1 &+& l2 = Reference (\f a -> refGet l1 f a `mplus` refGet l2 f a) 
+                      (\v -> refSet l1 v >=> refSet l2 v )
+                      (\trf -> refUpdate l1 trf
+                                 >=> refUpdate l2 trf )
+                      (\f a -> refGet' l1 f a `mplus` refGet' l2 f a) 
+                      (\v -> refSet' l1 v >=> refSet' l2 v )
+                      (\trf -> refUpdate' l1 trf
+                                 >=> refUpdate' l2 trf )
+infixl 5 &+&
+
+-- | Pack two references in parallel.
+(&|&) :: (RefMonads m m') 
+      => Reference m m m' m' s t a b -> Reference m m m' m' s' t' a' b' 
+           -> Reference m m m' m' (s, s') (t, t') (a, a') (b, b')
+r1 &|& r2 = Reference (\f (s1,s2) -> ((,) <$> refGet r1 return s1 <*> refGet r2 return s2) >>= f) 
+                      (\(b1,b2) (s1,s2) -> (,) <$> refSet r1 b1 s1 <*> refSet r2 b2 s2) 
+                      (\f (s1,s2) -> do a1 <- refGet r1 return s1
+                                        a2 <- refGet r2 return s2
+                                        t1 <- refUpdate r1 (liftM fst . flip (curry f) a2) s1
+                                        t2 <- refUpdate r2 (liftM snd . curry f a1) s2
+                                        return (t1, t2) ) 
+                      (\f (s1,s2) -> ((,) <$> refGet' r1 return s1 <*> refGet' r2 return s2) >>= f)
+                      (\(b1,b2) (s1,s2) -> (,) <$> refSet' r1 b1 s1 <*> refSet' r2 b2 s2)
+                      (\f (s1,s2) -> do a1 <- refGet' r1 return s1
+                                        a2 <- refGet' r2 return s2
+                                        t1 <- refUpdate' r1 (liftM fst . flip (curry f) a2) s1
+                                        t2 <- refUpdate' r2 (liftM snd . curry f a1) s2
+                                        return (t1, t2) )
+
+infixl 5 &|&
+
+              
+-- | Flips a reference to the other direction.
+-- The monads of the references can change when a reference is turned.
+turn :: Reference w r w' r' s t a b -> Reference w' r' w r a b s t
+turn (Reference refGet refSet refUpdate refGet' refSet' refUpdate')
+  = (Reference refGet' refSet' refUpdate' refGet refSet refUpdate)
+ Control/Reference/Examples/Examples.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase, TypeOperators, BangPatterns #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes #-}
+
+-- | A collection of random example references
+module Control.Reference.Examples.Examples where
+
+import Control.Reference
+
+import System.Exit
+import System.Timeout
+import Test.HUnit
+import Control.Instances.Morph
+import Control.Monad.Trans.Maybe
+import qualified Control.Lens as Lens
+import Control.Concurrent
+import Control.Monad.Identity
+import Control.Monad.Trans.List
+import Control.Applicative
+import Control.Monad.Writer
+import Data.Maybe
+import qualified Data.Array as Arr
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as IS
+import qualified Data.Sequence as Seq
+import qualified Data.Tree as T
+import Data.List as Ls
+
+data A = A deriving (Eq, Show)
+
+testAtArg :: Int -> Int
+testAtArg = (atArg 3 .= 0) (+1)
+
+test1 :: Maybe Int
+test1 = just .= 3 $ Nothing
+
+test2 :: Either A Int
+test2 = right .= 3 $ Right 2
+
+test3 :: Either A Int
+test3 = right .- (+1) $ Right 2
+
+test4 :: Either A (Maybe Int)
+test4 = right&just .- (+1) $ Right (Just 2)
+
+test5 :: Either A (Maybe [Int])
+test5 = right&just&(element 3) .- (+1) $ Right (Just [1..10])
+
+test6 :: (Int, Int)
+test6 = both .- (+1) $ (0, 1)
+
+test7 :: (Maybe Int, Maybe Int)
+test7 = both&just .- (+1) $ (Just 0, Nothing)
+
+-- should not block
+test8 :: IO (MVar Int)
+test8 = newEmptyMVar >>= emptyRef&mvar !- (+1)
+
+isoList :: Simple Iso [()] Int
+isoList = iso length (`replicate` ())
+
+test9 :: [()]
+test9 = isoList .- (+1) 
+          $ 3 ^. turn isoList
+
+test10 :: [Int]
+test10 = [1..10] ^? _tail&traversal &+& _tail&_tail&traversal
+
+test11 :: [Int]
+test11 = _tail&traversal &+& _tail&_tail&traversal .- (+1) $ replicate 10 1
+
+test12 :: Writer [String] (Int,Int)
+test12 = (both :: Simple (WriterTraversal [String] Identity) (Int,Int) Int) 
+  !| (tell . (:[]) . show) $ (0, 1)
+
+data Dept = Dept { _manager :: Employee
+                 , _staff :: [Employee] 
+                 } deriving (Eq, Show)
+data Employee = Employee { __name :: String
+                         , __salary :: Float
+                         } deriving (Eq, Show)
+                         
+$(Lens.makeLenses ''Employee)
+                         
+manager :: Lens Dept Dept Employee Employee
+manager = lens _manager (\b a -> a { _manager = b })
+
+staff :: Lens Dept Dept [Employee] [Employee]
+staff = lens _staff (\b a -> a { _staff = b })  
+                       
+name :: Lens Employee Employee String String
+name = fromLens _name
+
+salary :: Lens Employee Employee Float Float
+salary = fromLens _salary
+                                     
+dept = Dept (Employee "Agamemnon" 100000) [Employee "Akhilles" 30000, Employee "Menelaos" 40000]
+
+test13 :: Writer (Sum Float) Dept
+test13 = let salaryOfEmployees :: Simple (WriterTraversal (Sum Float) Identity) Dept Float
+             salaryOfEmployees = (staff&traversal &+& manager)&salary
+          in salaryOfEmployees !| tell . Sum
+               $ manager&name .- ("Mr. "++)
+               $ dept
+
+test14 :: [String]
+test14 = traversal .- (`replicate` 'x') $ [1..10]
+
+test15 :: (String, Char)
+test15 = let lens_1 = fromLens Lens._1
+          in lens_1 .- show $ (2,'a')
+
+test16 :: (Either Int Int, Either Int Int)
+test16 = (_1 &+& _2) & (left &+& right) .- (+1)
+           $ both & anyway .- subtract 1
+           $ (Left 3, Right 1)
+
+data PWrapped m a = PWrapped { _pwrap :: m a } deriving (Eq, Show)
+
+$(makeReferences ''PWrapped)
+
+test17 :: PWrapped Maybe String
+test17 = pwrap .- (return . show . runIdentity) $ (PWrapped (Identity (3 :: Int)))
+
+data MWrapped a = MWrapped { _mwrap :: Maybe a } deriving (Eq, Show)
+
+$(makeReferences ''MWrapped)
+
+test18 :: MWrapped String
+test18 = mwrap .- (fmap show) $ MWrapped (Just (3 :: Int))
+
+
+data Maybe' a = Just' { _fromJust' :: a }
+              | Nothing'
+              deriving (Eq, Show)
+              
+$(makeReferences ''Maybe')
+
+test19 :: Maybe' String
+test19 = fromJust' .- show $ Just' (42 :: Int)
+    
+data Tuple a b = Tuple { _fst' :: a, _snd' :: b } deriving (Eq, Show)
+         
+$(makeReferences ''Tuple)
+
+test20 :: Tuple Int String 
+test20 = fst' .- length
+         $ snd' .- show
+         $ Tuple "almafa" 42
+         
+test21 :: IM.IntMap String 
+test21 = element 2 .= "two"
+         $ element 3 .- (++"_")
+         $ at 4 .= Just "4"
+         $ IM.fromList [(5, "5"), (2, "2")]
+                  
+test22 :: Seq.Seq String 
+test22 = element 1 .- ("_"++)
+         $ element 3 .= "_"
+         $ Seq.fromList ["1","2","3"]
+         
+test23 :: Set.Set Int 
+test23 = contains 2 .= False
+         $ contains 3 .- not
+         $ contains 4 .- not
+         $ Set.fromList [1,2,3]
+         
+test24 :: IS.IntSet 
+test24 = contains 2 .= False
+         $ contains 3 .- not
+         $ contains 4 .- not
+         $ IS.fromList [1,2,3]       
+         
+test25 :: T.Tree Int
+test25 = (\tree -> element [1,0] .= fromJust (tree ^? element []) $ tree)
+           $ element [1] .- (+1)
+           $ element [2] .= 0
+           $ T.Node 1 [T.Node 2 [], T.Node 3 [T.Node 4 []]]
+           
+test26 :: Arr.Array Int String
+test26 = element 1 .- (++"!")
+           $ element 2 .= "World"
+           $ Arr.listArray (1,3) ["Hello","My","World"]
+         
+
+test27 :: Map.Map String Int
+test27 = at "2" .= Nothing
+         $ at "3" .- (fmap (subtract 1))
+         $ Map.fromList [("5",5), ("3",3), ("2",2)]
+         
+test28 :: Int -> Maybe String
+test28 = at 3 .= Nothing
+         $ element 1 .- (++"_")
+         $ \a -> if a > 0 then Just (show a) else Nothing
+         
+-- test29 :: (Maybe Int, Either Int String)
+-- test29 = let r = just &|& right
+          -- in r .- (\(a,b) -> (b,a)) $ (Just 3, Left 4)
+       
+data SameName a = Opt1 { _sameFld :: a }
+                | Opt2 { _sameFld :: a }
+              
+makeReferences ''SameName   
+
+sameFld' :: Simple Lens (SameName a) a
+sameFld' = sameFld
+
+data SameType a = SameType { sameType :: a, sameType2 :: a }
+     
+makeReferences ''SameType
+
+data HigherEither x y a 
+       = HigherLeft { _higherLeft :: x a }
+       | HigherRight { _higherRight :: y a }
+     
+makeReferences ''HigherEither
+       
+example1 :: IO String
+example1 = 
+  do result <- newEmptyMVar
+     updates <- replicateM 3 newEmptyMVar
+     hello <- newMVar (Just "World")
+     forkIO $ do mvar&just&_tail&_tail !- ('_':) $ hello
+                 mvar != () $ (updates !! 0)
+                 return ()
+     forkIO $ do mvar&just&(element 1) != 'u' $ hello
+                 mvar != () $ (updates !! 1)
+                 return ()
+     forkIO $ do mvar&just !- ("Hello " ++) $ hello
+                 mvar != () $ (updates !! 2)
+                 return ()
+                 
+     -- wait for all updates to happen
+     runListT $ (updates :: [MVar ()]) ^? traversal&mvar 
+     Just x <- runMaybeT $ hello ^? (mvar & just) 
+     mvar != x $ result
+     result ^? mvar
+
+tests = TestList [ 
+  TestCase $ assertEqual "atArg" [2,3,0,5,6] (map testAtArg [1..5])
+  , TestCase $ assertEqual "test1" Nothing test1
+  , TestCase $ assertEqual "test2" (Right 3) test2
+  , TestCase $ assertEqual "test3" (Right 3) test3
+  , TestCase $ assertEqual "test4" (Right (Just 3)) test4
+  , TestCase $ assertEqual "test5" (Right (Just [1,2,3,5,5,6,7,8,9,10])) test5
+  , TestCase $ assertEqual "test6" (1,2) test6
+  , TestCase $ assertEqual "test7" (Just 1,Nothing) test7
+  , TestCase $ assertBool "test8" =<< ((==) <$> (newEmptyMVar >>= tryTakeMVar)
+                                            <*> (test8 >>= tryTakeMVar))
+  , TestCase $ assertEqual "test9" [(),(),(),()] test9
+  , TestCase $ assertEqual "test10" ([2..10]++[3..10]) test10
+  , TestCase $ assertEqual "test11" ([1,2]++replicate 8 3) test11
+  , TestCase $ assertEqual "test12" ["0","1"] (execWriter test12)
+  , TestCase $ assertEqual "test13" (dept { _manager = Employee "Mr. Agamemnon" 100000 }, Sum 170000)
+                                    (runWriter test13)
+  , TestCase $ assertEqual "test14" [replicate i 'x' | i <- [1..10]] test14
+  , TestCase $ assertEqual "test15" ("2",'a') test15
+  , TestCase $ assertEqual "test16" (Left 3, Right 1) test16
+  , TestCase $ assertEqual "test17" (PWrapped (Just "3")) test17
+  , TestCase $ assertEqual "test18" (MWrapped (Just "3")) test18
+  , TestCase $ assertEqual "test19" (Just' "42") test19
+  , TestCase $ assertEqual "test20" (Tuple 6 "42") test20
+  , TestCase $ assertEqual "test21" (IM.fromList [(2,"two"),(4,"4"),(5,"5")]) test21
+  , TestCase $ assertEqual "test22" (Seq.fromList ["1","_2","3"]) test22
+  , TestCase $ assertEqual "test23" (Set.fromList [1,4]) test23
+  , TestCase $ assertEqual "test24" (IS.fromList [1,4]) test24
+  , TestCase $ assertEqual "test25" (T.Node 1 [T.Node 2 [], T.Node 4 [T.Node 1 []]]) test25
+  , TestCase $ assertEqual "test26" (Arr.listArray (1,3) ["Hello!","World","World"]) test26
+  , TestCase $ assertEqual "test27" (Map.fromList [("5",5), ("3",2)]) test27
+  , TestCase $ assertEqual "test28" ["1_", "2"] (catMaybes $ map test28 [0..3])
+  , TestCase $ do ex1 <- timeout 10000000 example1
+                  b <- case ex1 of Just x -> return $ ("_uH" Ls.\\ x) == ""
+                                   Nothing -> putStrLn "example1 is not evaluated on time" >> return False
+                  assertBool "example1" b
+  ]
+     
+ Control/Reference/Examples/Main.hs view
@@ -0,0 +1,11 @@+module Main where
+
+import Control.Reference.Examples.Examples
+
+import System.Exit
+import Test.HUnit
+
+main = do Counts _ _ err fail <- runTestTT tests
+          if (err + fail == 0) then exitSuccess
+                               else exitFailure
+
Control/Reference/Examples/TH.hs view
@@ -33,7 +33,7 @@ freeTypeVariables :: Simple Traversal Type Type
 freeTypeVariables = fromTraversal (freeTypeVariables' [])
   where freeTypeVariables' bn f (ForallT vars ctx t) 
-          = ForallT vars ctx <$> freeTypeVariables' (bn ++ (vars ^? traverse&typeVarName)) f t
+          = ForallT vars ctx <$> freeTypeVariables' (bn ++ (vars ^? traversal&typeVarName)) f t
         freeTypeVariables' bn f (AppT t1 t2) = AppT <$> freeTypeVariables' bn f t1 <*> freeTypeVariables' bn f t2
         freeTypeVariables' bn f (SigT t k) = SigT <$> freeTypeVariables' bn f t <*> pure k
         freeTypeVariables' bn f tv@(VarT n) = if n `elem` bn then pure tv else f tv
@@ -59,7 +59,7 @@ -- | Reference all fields (data members) in a constructor.
 conFields :: Simple Lens Con [(Strict, Type)]
 conFields = lens getFlds setFlds
-  where getFlds (NormalC _ flds) = flds	
+  where getFlds (NormalC _ flds) = flds
         getFlds (RecC _ flds) = map (\(_,a,b) -> (a,b)) flds
         getFlds (InfixC flds1 _ flds2) = [flds1, flds2]
         getFlds (ForallC _ _ c) = getFlds c
@@ -71,12 +71,12 @@ 
 -- | Reference types of fields
 conTypes :: Simple Traversal Con Type
-conTypes = conFields & traverse & _2
+conTypes = conFields & traversal & _2
         
 -- | Reference the name of the constructor
 conName :: Simple Lens Con Name
 conName = lens getName setName
-  where getName (NormalC n _)   = n	
+  where getName (NormalC n _)   = n
         getName (RecC n _)      = n
         getName (InfixC _ n _)  = n
         getName (ForallC _ _ c) = getName c
+ Control/Reference/Generators.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+
+-- | Functions to create references from simple functions 
+-- and members of the lens library.
+module Control.Reference.Generators where
+
+import Control.Reference.Representation
+import Control.Reference.Types
+
+import Control.Instances.Morph
+import qualified Data.Traversable as Trav
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Identity
+import Control.Monad.Writer
+import Data.Generics.Uniplate.Operations
+
+-- | Generates a traversal for any 'Trav.Traversable' 'Functor'
+traversal :: (Trav.Traversable t) => Traversal (t a) (t b) a b
+traversal = reference (morph . execWriter . Trav.mapM (tell . (:[])))
+                      (Trav.mapM . const . return) 
+                      Trav.mapM
+             
+-- | Generate a lens from a pair of inverse functions
+iso :: (a -> b) -> (b -> a) -> Simple Iso a b
+iso f g = bireference (return . f) (\b _ -> return . g $ b) (\trf a -> trf (f a) >>= return . g  ) 
+                      (return . g) (\a _ -> return . f $ a) (\trf b -> trf (g b) >>= return . f  ) 
+             
+iso' :: (a -> b) -> (a' -> b') -> (b -> a) -> (b' -> a') -> Iso a a' b b'
+iso' f f' g g' 
+  = bireference (return . f) (\b _ -> return . g' $ b) (\trf a -> trf (f a) >>= return . g'  ) 
+                (return . g) (\a _ -> return . f' $ a) (\trf b -> trf (g b) >>= return . f'  ) 
+
+-- | Generates a lens from a getter and a setter
+lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
+lens get set = reference (return . get) 
+                         (\b -> return . set b ) 
+                         (\f a -> f (get a) >>= \b -> return $ set b a)
+
+-- | Creates a polymorphic partial lense
+--
+-- @Either t a@ is used instead of @Maybe a@ to permit the types of 's' and 't' to differ.
+partial :: (s -> Either t (a, b -> t)) -> Partial s t a b
+partial access 
+  = reference 
+      (either (const $ morph Nothing) (return . fst) . access)
+      (\b -> return . either id (($b) . snd) . access)
+      (\f -> either return (\(a,set) -> f a >>= return . set) . access)
+         
+-- | Creates a polymorphic partial lens that can be turned to give a total lens
+prism :: (a -> s) -> (b -> t) -> (s -> Either t a) -> (t -> Maybe b) -> Prism s t a b
+prism back back' access access'
+  = bireference (either (const $ morph Nothing) return . access)
+                (\b -> return . either id (const $ (back' b)) . access)
+                (\f -> either return (f >=> return . back') . access)
+                (return . back)
+                (\t _ -> morph $ access' t)
+                (\f a -> f (back a) >>= morph . access')
+                
+-- | Creates a monomorphic partial lens that can be turned to give a total lens
+simplePrism :: (a -> s) -> (s -> Maybe a) -> Prism s s a a
+simplePrism back access = prism back back (\s -> maybe (Left s) Right (access s)) access
+                
+-- | Creates a simple partial lens
+simplePartial :: (s -> Maybe (a, a -> s)) -> Partial s s a a
+simplePartial access 
+  = partial (\s -> maybe (Left s) Right (access s))
+
+                                                     
+-- | Clones a lens from "Control.Lens"
+fromLens :: (forall f . Functor f => (a -> f b) -> s -> f t) -> Lens s t a b
+fromLens l = reference (\s -> return (getConst $ l Const s))
+                       (\b -> return . (runIdentity . l (\_ -> Identity b)))
+                       l
+                 
+-- | Clones a traversal from "Control.Lens"
+fromTraversal :: (forall f . Applicative f => (a -> f b) -> s -> f t) -> Traversal s t a b
+fromTraversal l = reference (morph . execWriter . l (\a -> tell [a] >> return undefined))
+                            (\b -> return . (runIdentity . l (\_ -> Identity b)))
+                            l
+                            
+-- | References all the elements accessed by uniplate
+uniplateRef :: Uniplate a => Simple Traversal a a
+uniplateRef = reference (morph . universe)
+                        (\b -> return . (transform (const b)))
+                        transformM
+                            
+-- | References all the elements accessed by biplate
+biplateRef :: Biplate a b => Simple Traversal a b
+biplateRef = reference (morph . universeBi)
+                       (\b -> return . (transformBi (const b)))
+                       transformBiM
+                            
+-- | Filters the traversed elements with a given predicate. 
+-- Has specific versions for traversals and partial lenses.
+filtered :: (a -> Bool) -> Simple RefPlus a a
+filtered p = reference (\s -> if p s then return s else mzero)
+                       (\a s -> if p s then return a else return s)
+                       (\f s -> if p s then f s else return s)
+                       
+                       
+                       
Control/Reference/InternalInterface.hs view
@@ -8,19 +8,19 @@ -- For creating a new interface with different generated elements, use this internal interface.
 --
 module Control.Reference.InternalInterface
-       ( Reference, bireference, reference, referenceWithClose
-       , Iso
-       , Simple, Getter, Setter
-       , Lens, Partial, Traversal
-       , IOLens, IOPartial, IOTraversal
-       , StateLens, StatePartial, StateTraversal
-       , WriterLens, WriterPartial, WriterTraversal
+       ( bireference, reference, referenceWithClose
+       , module Control.Reference.Types
        , module Control.Reference.Operators
+       , module Control.Reference.Combinators
        , module Control.Reference.Predefined
+       , module Control.Reference.Generators
        , module Control.Reference.Predefined.Containers
        ) where
 
 import Control.Reference.Representation
+import Control.Reference.Types
 import Control.Reference.Operators
+import Control.Reference.Combinators
 import Control.Reference.Predefined
+import Control.Reference.Generators
 import Control.Reference.Predefined.Containers
Control/Reference/Operators.hs view
@@ -3,46 +3,41 @@ {-# LANGUAGE LambdaCase, TypeOperators #-}
 
 --
--- | Common operators for using, transforming and combining.
+-- | Common operators for using references.
 --
 -- There are four kinds of operator for every type of reference.
 -- The operators are either getters ('^.' and '^?'), setters ('.=' and '!='), 
--- monadic updaters ('.~' and '!~'), pure updaters ('.-' and '!-') or action performers (@!|@).
+-- monadic updaters ('.~' and '!~'), pure updaters ('.-' and '!-') or action performers ('!|').
 --
--- The former operators (with the dot) are pure operators, the later are monadic operators. For example, @(1,2) ^. _1@ results in a pure numeric value, while @Right 4 ^? right@ produces @Just 4@ (or a higher level value representing that).
+-- The former operators (with the dot) are pure operators, the later are monadic operators. For example, @(1,2) ^. _1@ results in a pure numeric value, while @Right 4 ^? right@ produces @Just 4@ (or a higher level value representing @Just 4@).
 --
-
 module Control.Reference.Operators where
 
 import Control.Reference.Representation
+import Control.Reference.Types
+import Control.Reference.Combinators
 
 import Control.Instances.Morph
 import Control.Applicative
 import Control.Monad.Identity
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.List
-              
--- | Flips a reference to the other direction.
--- The monads of the references can change when a reference is turned.
-turn :: Reference w r w' r' s t a b -> Reference w' r' w r a b s t
-turn (Reference refGet refSet refUpdate refGet' refSet' refUpdate')
-  = (Reference refGet' refSet' refUpdate' refGet refSet refUpdate)
-  
--- | Gets the context from the referenced element by turning the reference.
-review :: Reference MU MU MU Identity s s a a -> a -> s
-review r a = a ^. turn r
 
 -- * Getters
 
 -- | Pure getter operator
-(^.) :: s -> Getter Identity s a -> a
+(^.) :: s -> Getter Identity s t a b -> a
 a ^. l = runIdentity (a ^? l)
 infixl 4 ^.
 
 -- | Generic getter operator
-(^?) :: Monad m => s -> Getter m s a -> m a
+(^?) :: Monad m => s -> Getter m s t a b -> m a
 a ^? l = refGet l return a
 infixl 4 ^?
+  
+-- | Gets the context from the referenced element by turning the reference.
+review :: Reference MU MU MU Identity s s a a -> a -> s
+review r a = a ^. turn r
 
 -- * Setters
 
@@ -86,67 +81,3 @@ (!|) :: Monad m => Setter m s s a a -> (a -> m c) -> s -> m s
 l !| act = l !~ (\v -> act v >> return v)
 infixl 4 !|
-
--- * Binary operators on references
-
--- | Composes two references. They must be of the same kind.
---
--- If reference @r@ accesses @b@ inside the context @a@, and reference @p@ accesses @c@ inside the context @b@,
--- than the reference @r&p@ will access @c@ inside @a@.
---
--- Composition is associative: @ (r&p)&q = r&(p&q) @
-(&) :: (Monad w, Monad r) => Reference w r w' r' s t c d -> Reference w r w' r' c d a b
-    -> Reference w r w' r' s t a b
-(&) l1 l2 = Reference (refGet l1 . refGet l2) 
-                      (refUpdate l1 . refSet l2) 
-                      (refUpdate l1 . refUpdate l2)
-                      (refGet' l2 . refGet' l1)
-                      (refUpdate' l2 . refSet' l1) 
-                      (refUpdate' l2 . refUpdate' l1)
-infixl 6 &
-
--- | Adds two references.
---
--- Using this operator may result in accessing the same parts of data multiple times.
--- For example @ twice = self &+& self @ is a reference that accesses itself twice:
---
--- > a ^? twice == [a,a]
--- > (twice *= x) a == x
--- > (twice .- f) a == f (f a)
---
--- Addition is commutative only if we do not consider the order of the results from a get,
--- or the order in which monadic actions are performed.
---
-(&+&) :: (RefMonads w r, RefMonads w' r', MonadPlus r, MonadPlus r', Morph [] r)
-         => Reference w r w' r' s s a a -> Reference w r w' r' s s a a
-         -> Reference w r w' r' s s a a
-l1 &+& l2 = Reference (\f a -> refGet l1 f a `mplus` refGet l2 f a) 
-                      (\v -> refSet l1 v >=> refSet l2 v )
-                      (\trf -> refUpdate l1 trf
-                                 >=> refUpdate l2 trf )
-                      (\f a -> refGet' l1 f a `mplus` refGet' l2 f a) 
-                      (\v -> refSet' l1 v >=> refSet' l2 v )
-                      (\trf -> refUpdate' l1 trf
-                                 >=> refUpdate' l2 trf )
-infixl 5 &+&
-
--- | Pack two references in parallel.
-(&|&) :: (RefMonads m m') 
-      => Reference m m m' m' s t a b -> Reference m m m' m' s' t' a' b' 
-           -> Reference m m m' m' (s, s') (t, t') (a, a') (b, b')
-r1 &|& r2 = Reference (\f (s1,s2) -> ((,) <$> refGet r1 return s1 <*> refGet r2 return s2) >>= f) 
-                      (\(b1,b2) (s1,s2) -> (,) <$> refSet r1 b1 s1 <*> refSet r2 b2 s2) 
-                      (\f (s1,s2) -> do a1 <- refGet r1 return s1
-                                        a2 <- refGet r2 return s2
-                                        t1 <- refUpdate r1 (liftM fst . flip (curry f) a2) s1
-                                        t2 <- refUpdate r2 (liftM snd . curry f a1) s2
-                                        return (t1, t2) ) 
-                      (\f (s1,s2) -> ((,) <$> refGet' r1 return s1 <*> refGet' r2 return s2) >>= f)
-                      (\(b1,b2) (s1,s2) -> (,) <$> refSet' r1 b1 s1 <*> refSet' r2 b2 s2)
-                      (\f (s1,s2) -> do a1 <- refGet' r1 return s1
-                                        a2 <- refGet' r2 return s2
-                                        t1 <- refUpdate' r1 (liftM fst . flip (curry f) a2) s1
-                                        t2 <- refUpdate' r2 (liftM snd . curry f a1) s2
-                                        return (t1, t2) )
-
-infixl 5 &|&
Control/Reference/Predefined.hs view
@@ -1,24 +1,23 @@ {-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase, TupleSections, TypeOperators #-}
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
-{-# LANGUAGE RankNTypes, TypeFamilies, FunctionalDependencies, LiberalTypeSynonyms #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RankNTypes, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies, FunctionalDependencies, LiberalTypeSynonyms #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
-#endif
 
-
 -- | Predefined references for commonly used data structures and reference generators.
 --
 -- When defining lenses one should use the more general types. For instance 'Lens' instead of the more strict 'Lens''. This way references with different @m1@ and @m2@ monads can be combined if there is a monad @m'@ for @MMorph m1 m'@ and @MMorph m2 m'@.
 module Control.Reference.Predefined where
 
 import Control.Reference.Representation
+import Control.Reference.Types
+import Control.Reference.Generators
+import Control.Reference.Combinators
 import Control.Reference.Operators
 
 import Control.Instances.Morph
 import Control.Applicative
 import Control.Monad
-import qualified Data.Traversable as Trav
 import Data.Ratio
 import qualified Data.Text as Text
 import Data.Complex
@@ -52,82 +51,12 @@ emptyRef :: Simple RefPlus s a
 emptyRef = reference (const mzero) (const return) (const return)
 
-
--- * Reference generators
-
--- | Generates a traversal for any 'Trav.Traversable' 'Functor'
-traverse :: (Trav.Traversable t) => Traversal (t a) (t b) a b
-traverse = reference (morph . execWriter . Trav.mapM (tell . (:[])))
-                     (Trav.mapM . const . return) 
-                     Trav.mapM
-             
--- | Generate a lens from a pair of inverse functions
-iso :: (a -> b) -> (b -> a) -> Simple Iso a b
-iso f g = bireference (return . f) (\b _ -> return . g $ b) (\trf a -> trf (f a) >>= return . g  ) 
-                      (return . g) (\a _ -> return . f $ a) (\trf b -> trf (g b) >>= return . f  ) 
-             
-iso' :: (a -> b) -> (a' -> b') -> (b -> a) -> (b' -> a') -> Iso a a' b b'
-iso' f f' g g' 
-  = bireference (return . f) (\b _ -> return . g' $ b) (\trf a -> trf (f a) >>= return . g'  ) 
-                (return . g) (\a _ -> return . f' $ a) (\trf b -> trf (g b) >>= return . f'  ) 
-
--- | Generates a lens from a getter and a setter
-lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
-lens get set = reference (return . get) 
-                         (\b -> return . set b ) 
-                         (\f a -> f (get a) >>= \b -> return $ set b a)
-
--- | Creates a polymorphic partial lense
---
--- @Either t a@ is used instead of @Maybe a@ to permit the types of 's' and 't' to differ.
-partial :: (s -> Either t (a, b -> t)) -> Partial s t a b
-partial access 
-  = reference 
-      (either (const $ morph Nothing) (return . fst) . access)
-      (\b -> return . either id (($b) . snd) . access)
-      (\f -> either return (\(a,set) -> f a >>= return . set) . access)
-         
--- | Creates a polymorphic partial lens that can be turned to give a total lens
-prism :: (a -> s) -> (b -> t) -> (s -> Either t a) -> (t -> Maybe b) -> Prism s t a b
-prism back back' access access'
-  = bireference (either (const $ morph Nothing) return . access)
-                (\b -> return . either id (const $ (back' b)) . access)
-                (\f -> either return (f >=> return . back') . access)
-                (return . back)
-                (\t _ -> morph $ access' t)
-                (\f a -> f (back a) >>= morph . access')
-                
--- | Creates a monomorphic partial lens that can be turned to give a total lens
-simplePrism :: (a -> s) -> (s -> Maybe a) -> Prism s s a a
-simplePrism back access = prism back back (\s -> maybe (Left s) Right (access s)) access
-                
--- | Creates a simple partial lens
-simplePartial :: (s -> Maybe (a, a -> s)) -> Partial s s a a
-simplePartial access 
-  = partial (\s -> maybe (Left s) Right (access s))
-
-                                                     
--- | Clones a lens from "Control.Lens"
-fromLens :: (forall f . Functor f => (a -> f b) -> s -> f t) -> Lens s t a b
-fromLens l = reference (\s -> return (getConst $ l Const s))
-                       (\b -> return . (runIdentity . l (\_ -> Identity b)))
-                       l
-                 
--- | Clones a traversal from "Control.Lens"
-fromTraversal :: (forall f . Applicative f => (a -> f b) -> s -> f t) -> Traversal s t a b
-fromTraversal l = reference (morph . execWriter . l (\a -> tell [a] >> return undefined))
-                            (\b -> return . (runIdentity . l (\_ -> Identity b)))
-                            l
-
--- | Filters the traversed elements with a given predicate. 
--- Has specific versions for traversals and partial lenses.
-filtered :: (a -> Bool) -> Simple RefPlus a a
-filtered p = reference (\s -> if p s then return s else mzero)
-                       (\a s -> if p s then return a else return s)
-                       (\f s -> if p s then f s else return s)
-
 -- * References for simple data structures
 
+-- | An indexed lens for accessing points a function
+atArg :: Eq a => a -> Simple Lens (a -> b) b
+atArg a = lens ($ a) (\b f -> \x -> if a == x then b else f x)
+
 -- | A partial lens to access the value that may not exist
 just :: Prism (Maybe a) (Maybe b) a b
 just = prism Just Just (maybe (Left Nothing) Right) id
@@ -322,3 +251,9 @@                   (\trf ref -> morph (readSTRef ref) >>= trf 
                                  >>= morph . writeSTRef ref >> return ref)     
  
+-- | Filters an indexed reference based on the index
+whereOf :: (RefMonads w r, MonadPlus r) 
+        => (i -> Bool) -> (IndexedReference i w r MU MU s s a a) -> (IndexedReference i w r MU MU s s a a)
+whereOf p iref i | p i       = iref i
+                 | otherwise = emptyRef
+                 
Control/Reference/Predefined/Containers.hs view
@@ -1,13 +1,16 @@ {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RankNTypes, FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-}
+
+-- | References for standard containers
 module Control.Reference.Predefined.Containers where
 
-import Control.Instances.Morph
 import Control.Reference.Representation
-import Control.Reference.Predefined
+import Control.Reference.Types
+import Control.Reference.Generators
 import Control.Reference.Operators
                  
+import Control.Instances.Morph
 import Data.Map as Map
 import qualified Data.Array as Arr
 import qualified Data.Set as Set
Control/Reference/Representation.hs view
@@ -1,23 +1,16 @@-{-# LANGUAGE KindSignatures, TypeOperators #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ScopedTypeVariables, RankNTypes #-}
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances
-           , MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
 
 
 -- | This module declares the representation and basic classes of references.
+-- Supplies primitive functions to create references.
 --
 -- This module should not be imported directly.
 module Control.Reference.Representation where
 
 import Data.Proxy
-import Control.Instances.Morph
 import Control.Applicative
-import Control.Monad
-import Control.Monad.State (StateT)
-import Control.Monad.Writer (WriterT)
-import Control.Monad.Identity (Identity(..))
-import Control.Monad.Trans.Maybe (MaybeT(..))
-import Control.Monad.ST (ST)
 
 -- | A reference is an accessor to a part or different view of some data. 
 -- The referenc has a separate getter, setter and updater. In some cases,
@@ -86,6 +79,8 @@               , refSet'     :: t -> a -> w' b
               , refUpdate'  :: (s -> w' t) -> a -> w' b
               }
+              
+type IndexedReference i w r w' r' s t a b = i -> Reference w r w' r' s t a b
 
 -- Creates a two-way reference
 bireference :: (RefMonads w r, RefMonads w' r')
@@ -140,7 +135,7 @@               (\b s -> set b s <* setClose s)
               (\trf s -> update trf s <* updateClose s)
               unusableOp unusableOp unusableOp
-                
+            
 -- | A simple class to enforce that both reader and writer semantics of the reference are 'Monad's
 -- (as well as 'Applicative's and 'Functor's)
 class ( Functor w, Applicative w, Monad w
@@ -149,175 +144,9 @@ instance ( Functor w, Applicative w, Monad w
          , Functor r, Applicative r, Monad r )
          => RefMonads w r where
-
+            
 type MU = Proxy
 
-instance Alternative MU where
-  empty = Proxy
-  _ <|> _ = Proxy
-  
-instance MonadPlus MU where
-  mzero = Proxy
-  mplus _ _ = Proxy
-
 unusableOp :: a -> b -> MU c
 unusableOp _ _ = Proxy
-         
--- | A monomorph 'Lens', 'Traversal', 'Partial', etc... 
--- Setting or updating does not change the type of the base.
-type Simple t s a = t s s a a
-
-type Getter r s a = Reference MU r MU MU s s a a
-
-type Setter w s t a b = Reference w MU MU MU s t a b
-
--- * Pure references
-                 
--- | A two-way 'Reference' that represents an isomorphism between two datatypes.
--- Can be used to access the same data in two different representations.
-type Iso s t a b
-  = forall w r w' r' . (RefMonads w r, RefMonads w' r') => Reference w r w' r' s t a b
-         
--- | A partial lens that can be turned to get a total lens.         
-type Prism s t a b
-  = forall w r w' r' . (RefMonads w r, RefMonads w' r'
-                       , MonadPlus r, Morph Maybe r 
-                       , MonadPlus w', Morph Maybe w') 
-      => Reference w r w' r' s t a b
-                 
--- | A 'Reference' that can access a part of data that exists in the context.
--- Every well-formed 'Reference' is a 'Lens'.
-type Lens s t a b
-  = forall w r . RefMonads w r => Reference w r MU MU s t a b
-
--- | A reference that may not have the accessed element, and that can
--- look for the accessed element in multiple locations.
-type RefPlus s t a b
-  = forall w r . ( RefMonads w r, MonadPlus r )
-    => Reference w r MU MU s t a b
-    
--- | Partial lens. A 'Reference' that can access data that may not exist in the context.
--- Every lens is a partial lens.
---
--- Any reference that is a partial lens should only perform the action given to its
--- 'updateRef' function if it can get a value (the value returned by 'getRef' is not
--- the lifted form of 'Nothing').
-type Partial s t a b
-  = forall w r . ( Functor w, Applicative w, Monad w
-                 , Functor r, Applicative r, MonadPlus r, Morph Maybe r )
-    => Reference w r MU MU s t a b
-    
--- | A reference that can access data that is available in a number of instances
--- inside the contexts.
--- 
--- Any reference that is a 'Traversal' should perform the action given to its
--- updater in the exactly the same number of times that is the number of the values
--- returned by it's 'getRef' function.
-type Traversal s t a b
-  = forall w r . (RefMonads w r, MonadPlus r, Morph Maybe r, Morph [] r )
-    => Reference w r MU MU s t a b
-
--- * References for 'IO'
-
-class ( Morph IO w, Morph IO r
-      , MorphControl IO w, MorphControl IO r ) => IOMonads w r where
-instance ( Morph IO w, Morph IO r
-         , MorphControl IO w, MorphControl IO r ) => IOMonads w r where
-
--- | A reference that can access mutable data.
-type IOLens s t a b
-  = forall w r . ( RefMonads w r, IOMonads w r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access mutable data that may not exist in the context.
-type IOPartial s t a b
-  = forall w r . (RefMonads w r, IOMonads w r, MonadPlus r, Morph Maybe r )
-    => Reference w r MU MU s t a b
-
-type IOTraversal s t a b
-  = forall w r . ( RefMonads w r, IOMonads w r, MonadPlus r, Morph Maybe r, Morph [] r )
-    => Reference w r MU MU s t a b
-
--- * References for 'StateT'
-
--- | A reference that can access a value inside a 'StateT' transformed monad.
-type StateLens st m s t a b
-  = forall w r . ( RefMonads w r, Morph (StateT st m) w, Morph (StateT st m) r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access a value inside a 'StateT' transformed monad
--- that may not exist.
-type StatePartial st m s t a b
-  = forall w r . ( RefMonads w r, Morph (StateT st m) w, MonadPlus r, Morph Maybe r, Morph (StateT st m) r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access a value inside a 'StateT' transformed monad
--- that may exist in multiple instances.
-type StateTraversal st m s t a b
-  = forall w r . ( RefMonads w r, Morph (StateT st m) w, MonadPlus r, Morph Maybe r, Morph [] r, Morph (StateT st m) r )
-    => Reference w r MU MU s t a b
-
--- * References for 'WriterT'
-
--- | A reference that can access a value inside a 'WriterT' transformed monad.
-type WriterLens st m s t a b
-  = forall w r . ( RefMonads w r, Morph (WriterT st m) w, Morph (WriterT st m) r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access a value inside a 'WriterT' transformed monad
--- that may not exist.
-type WriterPartial st m s t a b
-  = forall w r . ( RefMonads w r, Morph (WriterT st m) w, MonadPlus r, Morph Maybe r, Morph (WriterT st m) r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access a value inside a 'WriteT' transformed monad
--- that may exist in multiple instances.
-type WriterTraversal st m s t a b
-  = forall w r . ( RefMonads w r, Morph (WriterT st m) w, MonadPlus r, Morph Maybe r, Morph [] r, Morph (WriterT st m) r )
-    => Reference w r MU MU s t a b
-
--- * References for 'ST'
-
--- | A reference that can access a value inside an 'ST' transformed monad.
-type STLens st s t a b
-  = forall w r . ( RefMonads w r, Morph (ST st) w, Morph (ST st) r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access a value inside an 'ST' transformed monad
--- that may not exist.
-type STPartial st s t a b
-  = forall w r . ( RefMonads w r, Morph (ST st) w, MonadPlus r, Morph Maybe r, Morph (ST st) r )
-    => Reference w r MU MU s t a b
-
--- | A reference that can access a value inside an 'ST' transformed monad
--- that may exist in multiple instances.
-type STTraversal st s t a b
-  = forall w r . ( RefMonads w r, Morph (ST st) w, MonadPlus r, Morph Maybe r, Morph [] r, Morph (ST st) r )
-    => Reference w r MU MU s t a b
-
-class MorphControl (m1 :: * -> *) (m2 :: * -> *) where
-  type MSt m1 m2 :: * -> *
-  sink :: m2 a -> m1 (MSt m1 m2 a)
-  pullBack :: m1 (MSt m1 m2 a) -> m2 a
-  
-instance MorphControl IO (MaybeT IO) where
-  type MSt IO (MaybeT IO) = Maybe
-  sink (MaybeT m) = m
-  pullBack = MaybeT
-  
--- FIXME: conflicts with MorphControl m MU
--- instance (Monad m, Morph m m) => MorphControl m m where
-  -- type MSt m m = Identity
-  -- sink m = m >>= return . Identity
-  -- pullBack m = m >>= return . runIdentity
-  
-instance (Monad IO, Morph IO IO) => MorphControl IO IO where
-  type MSt IO IO = Identity
-  sink m = m >>= return . Identity
-  pullBack m = m >>= return . runIdentity
-  
-instance (Monad m, Morph m MU) => MorphControl m MU where
-  type MSt m MU = Proxy
-  sink _ = return Proxy
-  pullBack _ = Proxy
-  
+            
Control/Reference/TH/Records.hs view
@@ -46,6 +46,7 @@ import qualified Data.Map as M
 import Data.List
 import Data.Maybe
+import Data.Function (on)
 import Control.Monad
 import Control.Monad.Writer
 import Control.Monad.Trans.State
@@ -65,21 +66,29 @@   = do inf <- reify n
        case inf of
          TyConI decl -> case newtypeToData decl of
-           DataD ctx tyConName args cons _ -> case cons of
-             [con] -> makeLensesForCon tyConName args con 
-             _ -> liftM concat $ mapM (makePartialLensesForCon tyConName args cons) cons
+           DataD _ tyConName args cons _ -> 
+              createReferences tyConName (args ^? traversal&typeVarName) cons
            _ -> fail "makeReferences: Unsupported data type"
          _ -> fail "makeReferences: Expected the name of a data type or newtype"
-                
-
-makeLensesForCon :: Name -> [TyVarBndr] -> Con -> Q [Dec]
-makeLensesForCon tyName tyVars (RecC conName conFields) 
-  = liftM concat $ mapM (\(n, _, t) -> createLensForField tyName tyVars conName n t) conFields
-makeLensesForCon _ _ _ = return []
-             
-createLensForField :: Name -> [TyVarBndr] -> Name -> Name -> Type -> Q [Dec]
-createLensForField typName typArgs conName fldName fldTyp 
-  = do lTyp <- referenceType (ConT ''Lens) typName typArgs fldTyp  
+           
+createReferences :: Name -> [Name] -> [Con] -> Q [Dec]
+createReferences tyConName args cons
+  = let toGenerate = group $ sortBy (compare `on` fst) $ concat $ map getConFlds cons
+        -- only those type vars are mutable that appear in at most once in all of the constructors
+        mutableVars = foldl (\a (_,t) -> foldl (flip delete) a (t ^? typeVariableNames :: [Name])) (args++args) (map head toGenerate)
+        -- those references will be complete that are generated from fields that are present in every constructor
+        (complete, partials) 
+          = partition ((length cons ==) . length) 
+              $  toGenerate
+    in do comps <- mapM (createLensForField tyConName args mutableVars . head) complete 
+          parts <- mapM (createPartialLensForField tyConName args mutableVars cons . head) partials 
+          return $ concat (comps ++ parts)
+  where getConFlds con@(RecC conName conFields) = map (\(n,_,t) -> (n, t)) conFields
+        getConFlds _                            = []
+           
+createLensForField :: Name -> [Name] -> [Name] -> (Name,Type) -> Q [Dec]
+createLensForField typName typArgs mutArgs (fldName,fldTyp) 
+  = do lTyp <- referenceType (ConT ''Lens) typName typArgs mutArgs fldTyp  
        lensBody <- genLensBody
        return [ SigD lensName lTyp
               , ValD (VarP lensName) (NormalB $ lensBody) []
@@ -92,18 +101,12 @@                 origVar <- newName "s"
                 return $ VarE 'lens 
                            `AppE` VarE fldName 
-                           `AppE` LamE [VarP setVar, AsP origVar (RecP conName [])] 
+                           `AppE` LamE [VarP setVar, VarP origVar] 
                                        (RecUpdE (VarE origVar) [(fldName,VarE setVar)])
-           
-           
-makePartialLensesForCon :: Name -> [TyVarBndr] -> [Con] -> Con -> Q [Dec]
-makePartialLensesForCon tyName tyVars cons (RecC conName conFields) 
-  = liftM concat $ mapM (\(n, _, t) -> createPartialLensForField tyName tyVars conName cons n t) conFields
-makePartialLensesForCon _ _ _ _ = return []
-           
-createPartialLensForField :: Name -> [TyVarBndr] -> Name -> [Con] -> Name -> Type -> Q [Dec]
-createPartialLensForField  typName typArgs conName cons fldName fldTyp 
-  = do lTyp <- referenceType (ConT ''Partial) typName typArgs fldTyp  
+            
+createPartialLensForField :: Name -> [Name] -> [Name] -> [Con] -> (Name,Type) -> Q [Dec]
+createPartialLensForField typName typArgs mutArgs cons (fldName,fldTyp)
+  = do lTyp <- referenceType (ConT ''Partial) typName typArgs mutArgs fldTyp  
        lensBody <- genLensBody
        return [ SigD lensName lTyp
               , ValD (VarP lensName) (NormalB $ lensBody) []
@@ -141,13 +144,13 @@          matchWithoutField con 
            = do (bind, rebuild, _) <- bindAndRebuild con
                 return $ Match bind (NormalB (ConE 'Left `AppE` rebuild)) []              
-           
-referenceType :: Type -> Name -> [TyVarBndr] -> Type -> Q Type
-referenceType refType name args fldTyp 
-  = do let argTypes = args ^? traverse&typeVarName
-       (fldTyp',mapping) <- makePoly argTypes fldTyp
-       let args' = traverse&typeVarName .- (\a -> fromMaybe a (mapping ^? element a)) $ args
-       return $ ForallT (map PlainTV (sort (nub (M.elems mapping ++ argTypes)))) [] 
+
+-- | Creates the type of the reference being defined
+referenceType :: Type -> Name -> [Name] -> [Name] -> Type -> Q Type
+referenceType refType name args mutArgs fldTyp 
+  = do (fldTyp',mapping) <- makePoly mutArgs fldTyp
+       let args' = traversal .- (\a -> fromMaybe a (mapping ^? element a)) $ args
+       return $ ForallT (map PlainTV (sort (nub (M.elems mapping ++ args)))) [] 
                         (refType `AppT` addTypeArgs name args 
                                  `AppT` addTypeArgs name args' 
                                  `AppT` fldTyp 
@@ -157,7 +160,7 @@ makePoly :: [Name] -> Type -> Q (Type, M.Map Name Name)
 makePoly typArgs fldTyp 
   = runStateT (typVarsBounded !~ updateName $ fldTyp) M.empty           
-  where typVarsBounded :: Simple (StateTraversal (M.Map Name Name) Q) Type Name
+  where typVarsBounded :: Simple Traversal Type Name
         typVarsBounded = typeVariableNames & filtered (`elem` typArgs)
         updateName name = do name' <- lift (newName (nameBase name ++ "'")) 
                              modify (M.insert name name')
@@ -173,15 +176,14 @@ -- * Helper functions 
 
 hasField :: Name -> Con -> Bool
-hasField n = not . null . (^? recFields & traverse & _1 & filtered (==n))
+hasField n c = not $ null (c ^? recFields & traversal & _1 & filtered (==n) :: [Name])
          
 fieldIndex :: Name -> Con -> Maybe Int
 fieldIndex n con = (con ^? recFields) >>= findIndex (\f -> (f ^. _1) == n)
          
 -- | Creates a type from applying binded type variables to a type function
-addTypeArgs :: Name -> [TyVarBndr] -> Type
-addTypeArgs n = foldl AppT (ConT n) 
-                  . map (VarT . (^. typeVarName))
+addTypeArgs :: Name -> [Name] -> Type
+addTypeArgs n = foldl AppT (ConT n) . map VarT
  
 newtypeToData :: Dec -> Dec
 newtypeToData (NewtypeD ctx name tvars con derives) 
Control/Reference/TH/Tuple.hs view
@@ -1,99 +1,99 @@-{-# LANGUAGE TemplateHaskell #-}--- | A module for creating lenses to fields of simple, tuple data structures --- like pairs, triplets, and so on.-module Control.Reference.TH.Tuple (TupleConf(..), hsTupConf, makeTupleRefs) where--import Language.Haskell.TH-import Control.Monad-import Control.Applicative-import Data.Maybe--import Control.Reference.InternalInterface---- | Creates @Lens_1@ ... @Lens_n@ classes, and instances for tuples up to 'm'.--- --- Classes and instances look like the following:--- --- @--- class Lens_1 s t a b | s -> a, t -> b---                      , a t -> s, b s -> t where ---   _1 :: Lens s t a b------ instance Lens_1 (a,b) (a',b) a a' where ---   _1 = lens (\(a,b) -> a) (\a' (a,b) -> (a',b))--- @----makeTupleRefs :: TupleConf -> Int -> Int -> Q [Dec]-makeTupleRefs conf n m -  = (++) <$> (catMaybes <$> genClass `mapM` [0..(n-1)]) -         <*> (genInstance conf -                  `mapM` [ (x, y) | x <- [0..(n-1)]-                                  , y <- [(max 2 (x+1))..m] ])             --genClass :: Int -> Q (Maybe Dec)-genClass i -  = do declared <- classDeclared i-       if declared then return Nothing-                   else Just <$> genClass' i-  where genClass' i = -          do s <- newName "s"-             t <- newName "t"-             a <- newName "a"-             b <- newName "b1"-             let tvars = map PlainTV [s,t,a,b]-             return $ ClassD [] (lensClass i) tvars-                             [ FunDep [s] [a], FunDep [t] [b]-                             , FunDep [a,t] [s], FunDep [b,s] [t]] -                             [ SigD (lensFun i) -                                    (foldl AppT (ConT ''Lens) (map VarT [s,t,a,b]))         -                             ]    --lensClass i = mkName ("Lens_" ++ show (i+1))-lensFun i = mkName ("_" ++ show (i+1))-  -classDeclared :: Int -> Q Bool -classDeclared i = isJust <$> lookupTypeName (nameBase $ lensClass i)--genInstance :: TupleConf -> (Int,Int) -> Q Dec-genInstance (TupleConf typGen patGen expGen) (n,m)-  = do names <- replicateM m (newName "a")-       name <- newName "b2"-       genBody <- generateBody-       return $ InstanceD [] (ConT (lensClass n) -                                `AppT` typGen names-                                `AppT` typGen (replace n name names)-                                `AppT` VarT (names !! n)-                                `AppT` VarT name-                             ) -                             [ ValD (VarP (lensFun n) ) -                                    (NormalB genBody) [] ]--  where generateBody :: Q Exp-        generateBody-          = do names <- replicateM m (newName "a")-               name <- newName "b3"-               return $ VarE 'lens -                          `AppE` LamE [patGen names] -                                      (VarE (names !! n))-                          `AppE` LamE [VarP name, patGen names] -                                      (expGen (replace n name names))---- | A tuple configuration is a scheme for tuple-like data structures.-data TupleConf = TupleConf { tupleType      :: [Name] -> Type-                           , tuplePattern   :: [Name] -> Pat-                           , tupleExpr      :: [Name] -> Exp-                           }-        --- | Generates the normal haskell tuples (@(a,b), (a,b,c), (a,b,c,d)@)        -hsTupConf -  = TupleConf (\names -> foldl AppT (TupleT (length names)) . map VarT $ names) -              (TupP . map VarP) -              (TupE . map VarE)-                  --- | Utility function to replace the N'th element of a list                         -replace :: Int -> a -> [a] -> [a]-replace i e ls -  = let (before,after) = splitAt i ls -     in case after of [] -> error $ "replace : Index " ++ show i ++ " is not found." -                      _:rest -> before ++ e : rest- +{-# LANGUAGE TemplateHaskell #-}
+-- | A module for creating lenses to fields of simple, tuple data structures 
+-- like pairs, triplets, and so on.
+module Control.Reference.TH.Tuple (TupleConf(..), hsTupConf, makeTupleRefs) where
+
+import Language.Haskell.TH
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
+
+import Control.Reference.InternalInterface
+
+-- | Creates @Lens_1@ ... @Lens_n@ classes, and instances for tuples up to 'm'.
+-- 
+-- Classes and instances look like the following:
+-- 
+-- @
+-- class Lens_1 s t a b | s -> a, t -> b
+--                      , a t -> s, b s -> t where 
+--   _1 :: Lens s t a b
+--
+-- instance Lens_1 (a,b) (a',b) a a' where 
+--   _1 = lens (\(a,b) -> a) (\a' (a,b) -> (a',b))
+-- @
+--
+makeTupleRefs :: TupleConf -> Int -> Int -> Q [Dec]
+makeTupleRefs conf n m 
+  = (++) <$> (catMaybes <$> genClass `mapM` [0..(n-1)]) 
+         <*> (genInstance conf 
+                  `mapM` [ (x, y) | x <- [0..(n-1)]
+                                  , y <- [(max 2 (x+1))..m] ])             
+
+genClass :: Int -> Q (Maybe Dec)
+genClass i 
+  = do declared <- classDeclared i
+       if declared then return Nothing
+                   else Just <$> genClass' i
+  where genClass' i = 
+          do s <- newName "s"
+             t <- newName "t"
+             a <- newName "a"
+             b <- newName "b1"
+             let tvars = map PlainTV [s,t,a,b]
+             return $ ClassD [] (lensClass i) tvars
+                             [ FunDep [s] [a], FunDep [t] [b]
+                             , FunDep [a,t] [s], FunDep [b,s] [t]] 
+                             [ SigD (lensFun i) 
+                                    (foldl AppT (ConT ''Lens) (map VarT [s,t,a,b]))         
+                             ]    
+
+lensClass i = mkName ("Lens_" ++ show (i+1))
+lensFun i = mkName ("_" ++ show (i+1))
+  
+classDeclared :: Int -> Q Bool 
+classDeclared i = isJust <$> lookupTypeName (nameBase $ lensClass i)
+
+genInstance :: TupleConf -> (Int,Int) -> Q Dec
+genInstance (TupleConf typGen patGen expGen) (n,m)
+  = do names <- replicateM m (newName "a")
+       name <- newName "b2"
+       genBody <- generateBody
+       return $ InstanceD [] (ConT (lensClass n) 
+                                `AppT` typGen names
+                                `AppT` typGen (replace n name names)
+                                `AppT` VarT (names !! n)
+                                `AppT` VarT name
+                             ) 
+                             [ ValD (VarP (lensFun n) ) 
+                                    (NormalB genBody) [] ]
+
+  where generateBody :: Q Exp
+        generateBody
+          = do names <- replicateM m (newName "a")
+               name <- newName "b3"
+               return $ VarE 'lens 
+                          `AppE` LamE [patGen names] 
+                                      (VarE (names !! n))
+                          `AppE` LamE [VarP name, patGen names] 
+                                      (expGen (replace n name names))
+
+-- | A tuple configuration is a scheme for tuple-like data structures.
+data TupleConf = TupleConf { tupleType      :: [Name] -> Type
+                           , tuplePattern   :: [Name] -> Pat
+                           , tupleExpr      :: [Name] -> Exp
+                           }
+        
+-- | Generates the normal haskell tuples (@(a,b), (a,b,c), (a,b,c,d)@)        
+hsTupConf 
+  = TupleConf (\names -> foldl AppT (TupleT (length names)) . map VarT $ names) 
+              (TupP . map VarP) 
+              (TupE . map VarE)
+                  
+-- | Utility function to replace the N'th element of a list                         
+replace :: Int -> a -> [a] -> [a]
+replace i e ls 
+  = let (before,after) = splitAt i ls 
+     in case after of [] -> error $ "replace : Index " ++ show i ++ " is not found." 
+                      _:rest -> before ++ e : rest
+ 
Control/Reference/TupleInstances.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}---- | A module where tuple classes and instances are created up to 16-tuple using 'makeTupleRefs'.--- The number of classes and instances can be changed by hiding import from this module--- and calling 'makeTupleRefs' in an other module.-module Control.Reference.TupleInstances where--import Control.Reference.TH.Tuple--$(makeTupleRefs hsTupConf 16 16)-+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
+
+-- | A module where tuple classes and instances are created up to 16-tuple using 'makeTupleRefs'.
+-- The number of classes and instances can be changed by hiding import from this module
+-- and calling 'makeTupleRefs' in an other module.
+module Control.Reference.TupleInstances where
+
+import Control.Reference.TH.Tuple
+
+$(makeTupleRefs hsTupConf 16 16)
+
+ Control/Reference/Types.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies #-}
+{-# LANGUAGE KindSignatures, MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | This module defines the polymorphic types of the created references.
+-- The actual type of a reference can be different for every usage,
+-- the polymorphic type gives a lower bound on the actual one.
+module Control.Reference.Types where
+    
+import Control.Reference.Representation
+    
+import Control.Instances.Morph
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State (StateT)
+import Control.Monad.Writer (WriterT)
+import Control.Monad.Identity (Identity(..))
+import Control.Monad.Trans.List (ListT(..))
+import Control.Monad.Trans.Maybe (MaybeT(..))
+import Control.Monad.ST (ST)
+import Data.Proxy
+    
+instance Alternative MU where
+  empty = Proxy
+  _ <|> _ = Proxy
+  
+instance MonadPlus MU where
+  mzero = Proxy
+  mplus _ _ = Proxy
+         
+-- | A monomorph 'Lens', 'Traversal', 'Partial', etc... 
+-- Setting or updating does not change the type of the base.
+type Simple t s a = t s s a a
+
+-- A read-only reference
+type Getter r s t a b = Reference MU r MU MU s t a b
+
+-- A write (and update) -only reference
+type Setter w s t a b = Reference w MU MU MU s t a b
+
+-- * Pure references
+                 
+-- | A two-way 'Reference' that represents an isomorphism between two datatypes.
+-- Can be used to access the same data in two different representations.
+type Iso s t a b
+  = forall w r w' r' . (RefMonads w r, RefMonads w' r') => Reference w r w' r' s t a b
+         
+-- | A partial lens that can be turned to get a total lens.         
+type Prism s t a b
+  = forall w r w' r' . (RefMonads w r, RefMonads w' r'
+                       , MonadPlus r, Morph Maybe r 
+                       , MonadPlus w', Morph Maybe w') 
+      => Reference w r w' r' s t a b
+                 
+-- | A 'Reference' that can access a part of data that exists in the context.
+-- A 'Lens' can have any read and write semantics that a 'Reference' can have.
+type Lens s t a b
+  = forall w r . RefMonads w r => Reference w r MU MU s t a b
+
+-- | A reference that may not have the accessed element, and that can
+-- look for the accessed element in multiple locations.
+type RefPlus s t a b
+  = forall w r . ( RefMonads w r, MonadPlus r )
+    => Reference w r MU MU s t a b
+    
+-- | Partial lens. A 'Reference' that can access data that may not exist in the context.
+-- Every lens is a partial lens.
+--
+-- Any reference that is a partial lens should only perform the action given to its
+-- 'updateRef' function if it can get a value (the value returned by 'getRef' is not
+-- the lifted form of 'Nothing').
+type Partial s t a b
+  = forall w r . ( Functor w, Applicative w, Monad w
+                 , Functor r, Applicative r, MonadPlus r, Morph Maybe r )
+    => Reference w r MU MU s t a b
+    
+-- | A reference that can access data that is available in a number of instances
+-- inside the contexts.
+-- 
+-- Any reference that is a 'Traversal' should perform the action given to its
+-- updater in the exactly the same number of times that is the number of the values
+-- returned by it's 'getRef' function.
+type Traversal s t a b
+  = forall w r . (RefMonads w r, MonadPlus r, Morph Maybe r, Morph [] r )
+    => Reference w r MU MU s t a b
+
+-- * References for 'IO'
+
+class ( Morph IO w, Morph IO r
+      , MorphControl IO w, MorphControl IO r ) => IOMonads w r where
+instance ( Morph IO w, Morph IO r
+         , MorphControl IO w, MorphControl IO r ) => IOMonads w r where
+
+-- | A reference that can access mutable data.
+type IOLens s t a b
+  = forall w r . ( RefMonads w r, IOMonads w r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access mutable data that may not exist in the context.
+type IOPartial s t a b
+  = forall w r . (RefMonads w r, IOMonads w r, MonadPlus r, Morph Maybe r )
+    => Reference w r MU MU s t a b
+
+type IOTraversal s t a b
+  = forall w r . ( RefMonads w r, IOMonads w r, MonadPlus r, Morph Maybe r, Morph [] r )
+    => Reference w r MU MU s t a b
+
+-- * References for 'StateT'
+
+-- | A reference that can access a value inside a 'StateT' transformed monad.
+type StateLens st m s t a b
+  = forall w r . ( RefMonads w r, Morph (StateT st m) w, Morph (StateT st m) r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access a value inside a 'StateT' transformed monad
+-- that may not exist.
+type StatePartial st m s t a b
+  = forall w r . ( RefMonads w r, Morph (StateT st m) w, MonadPlus r, Morph Maybe r, Morph (StateT st m) r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access a value inside a 'StateT' transformed monad
+-- that may exist in multiple instances.
+type StateTraversal st m s t a b
+  = forall w r . ( RefMonads w r, Morph (StateT st m) w, MonadPlus r, Morph Maybe r, Morph [] r, Morph (StateT st m) r )
+    => Reference w r MU MU s t a b
+
+-- * References for 'WriterT'
+
+-- | A reference that can access a value inside a 'WriterT' transformed monad.
+type WriterLens st m s t a b
+  = forall w r . ( RefMonads w r, Morph (WriterT st m) w, Morph (WriterT st m) r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access a value inside a 'WriterT' transformed monad
+-- that may not exist.
+type WriterPartial st m s t a b
+  = forall w r . ( RefMonads w r, Morph (WriterT st m) w, MonadPlus r, Morph Maybe r, Morph (WriterT st m) r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access a value inside a 'WriteT' transformed monad
+-- that may exist in multiple instances.
+type WriterTraversal st m s t a b
+  = forall w r . ( RefMonads w r, Morph (WriterT st m) w, MonadPlus r, Morph Maybe r, Morph [] r, Morph (WriterT st m) r )
+    => Reference w r MU MU s t a b
+
+-- * References for 'ST'
+
+-- | A reference that can access a value inside an 'ST' transformed monad.
+type STLens st s t a b
+  = forall w r . ( RefMonads w r, Morph (ST st) w, Morph (ST st) r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access a value inside an 'ST' transformed monad
+-- that may not exist.
+type STPartial st s t a b
+  = forall w r . ( RefMonads w r, Morph (ST st) w, MonadPlus r, Morph Maybe r, Morph (ST st) r )
+    => Reference w r MU MU s t a b
+
+-- | A reference that can access a value inside an 'ST' transformed monad
+-- that may exist in multiple instances.
+type STTraversal st s t a b
+  = forall w r . ( RefMonads w r, Morph (ST st) w, MonadPlus r, Morph Maybe r, Morph [] r, Morph (ST st) r )
+    => Reference w r MU MU s t a b
+
+-- | A class for representing calculation in a simpler monad.
+-- 
+-- @pullBack . sink === id@
+class MorphControl (m1 :: * -> *) (m2 :: * -> *) where
+  data MSt m1 m2 a :: *
+  sink :: m2 a -> m1 (MSt m1 m2 a)
+  pullBack :: m1 (MSt m1 m2 a) -> m2 a
+  
+instance Monad m => MorphControl m (MaybeT m) where
+  newtype MSt m (MaybeT m) a = MaybeMSt { fromMaybeMSt :: Maybe a }
+  sink = liftM MaybeMSt . runMaybeT
+  pullBack = MaybeT . liftM fromMaybeMSt
+  
+instance Monad m => MorphControl m (ListT m) where
+  newtype MSt m (ListT m) a = ListMSt { fromListMSt :: [a] }
+  sink = liftM ListMSt . runListT
+  pullBack = ListT . liftM fromListMSt
+  
+-- FIXME: conflicts with other instance declarations
+-- instance (Monad m, Morph m m) => MorphControl m m where
+  -- newtype MSt m m a = ReflMSt { fromReflMSt :: a }
+  -- sink = liftM ReflMSt
+  -- pullBack = liftM fromReflMSt
+  
+instance MorphControl IO IO where
+  newtype MSt IO IO a = ReflIOMSt { fromReflIOMSt :: a }
+  sink = liftM ReflIOMSt
+  pullBack = liftM fromReflIOMSt
+    
+-- instance MorphControl Identity m where
+  -- newtype MSt Identity m a = IdMSt { fromIdMSt :: m a }
+  -- sink = Identity . IdMSt
+  -- pullBack = fromIdMSt . runIdentity
+  
+instance (Monad m) => MorphControl m MU where
+  newtype MSt m MU a = ProxyMSt ()
+  sink _ = return (ProxyMSt ())
+  pullBack _ = Proxy
+  
LICENSE view
@@ -1,27 +1,27 @@-Copyright (c) 2014, lazac-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--* Redistributions of source code must retain the above copyright notice, this-  list of conditions and the following disclaimer.--* 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.--* Neither the name of the {organization} nor the names of its-  contributors may be used to endorse or promote products derived from-  this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT HOLDER 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.+Copyright (c) 2014, lazac
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* 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.
+
+* Neither the name of the {organization} nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT HOLDER 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.
+ README.md view
@@ -0,0 +1,44 @@+References are data accessors that can read, write or update the accessed infromation through their context.
+They are first-class values, can be passed in functions, transformed, combined.
+References generalize lenses, folds and traversals for haskell (see: https://hackage.haskell.org/package/lens).
+
+References are more general than field selectors in traditional languages.
+ * References are first-class values. If there is a struct in C, for example, with an `int` field `fl`, then fl can only be used as part of an expression. One can not generalize a function to take a field selector and transform the selected data or use it in other ways.
+ * They can have different meanings, while field accessors can only represent data-level containment. They can express uncertain containment (like field selectors of C unions), different viewpoints of the same data, and other concepts.
+
+References are more potent than lenses, folds and traversals:
+ * References can cooperate with monads, for example IO. This opens many new applications.
+ * References can be added using the `&+&` operator, to create new lenses more easily.
+
+Basic idea taken from the currently not maintained package https://hackage.haskell.org/package/yall. 
+
+An example use of the references (a logger application that spawns new threads to update a global log):
+
+```haskell
+logger =
+  (forever $ do
+     log <- logChan ^? chan&logRecord    -- Extract the log record from the received log message
+     thrId <- forkIO (do time <- getTime
+                         ioref&lastLogTime != time $ logDB     -- Update the last logging time mutable log database
+                         let logMsg = senderThread .- show     -- Transform the thread id to a string and
+                                        $ loggingTime .= time  -- update the time
+                                        $ log                  -- inside the log message
+                         ioref&debugInfos !~ addLogEntry log $ logDB  -- update the table of log entries
+                         mvar !- (+1) $ count )
+     mvar !- (thrId:) $ updaters                               -- Record the spawned thread
+    ) `catch` stopUpdaters updaters
+  where stopUpdaters updaters ThreadKilled =    
+          mvar&traverse !| killThread $ updaters               -- Kill all spawned threads before stopping
+```
+
+There are a number of predefined references for datatypes included in standard libraries.
+
+New references can be created in several ways:
+ * From getter, setter and updater, using the `reference` function.
+ * From getter and setter, using one of the simplified functions (`lens`, `simplePartial`, `partial`, ...).
+ * Using the `Data.Traversal` instance on a datatype to generate a traversal of each element.
+ * Using lenses from `Control.Lens` package. There are a lot of packages defining lenses, folds and traversals for various data structures, so it is very useful that all of them can simply be converted into a reference.
+ * Generating references for newly defined datatypes using the `makeReferences` Template Haskell function.
+
+
+
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain
references.cabal view
@@ -1,6 +1,6 @@ name:                references
-version:             0.3.0.0
-synopsis:            Generalization of lenses, folds and traversals to handle monads and addition.
+version:             0.3.0.1
+synopsis:            Selectors for reading and updating data.
 
 description:         References are data accessors that can read, write or update the accessed infromation through their context. They are first-class values, can be passed in functions, transformed, combined. References generalize lenses, folds and traversals for haskell (see: < https://hackage.haskell.org/package/lens>).
 		     .
@@ -56,41 +56,54 @@ license-file:        LICENSE
 author:              Boldizsar Nemeth
 maintainer:          nboldi@elte.hu
--- copyright:           
+copyright:           Boldizsar Nemeth, 2014
 category:            Control
 build-type:          Simple
 cabal-version:       >=1.8
 
--- For some reason, cabal won't allow me to write this:
---
--- source-repository:   head
---   type:       git
---   location:   git://github.com/lazac/references.git
--- source-repository:   this
---   type:       git
---   location:   git://github.com/lazac/references.git
---   tag:        0.2.1.2
+extra-source-files:
+  README.md
+  CHANGELOG.md
+  Control/Reference/Examples/Examples.hs
+  Control/Reference/Examples/Main.hs
 
+test-suite lens-creation
+  type:           exitcode-stdio-1.0
+  main-is:        Control/Reference/Examples/Main.hs
+  build-depends:  base, text, array, mtl, transformers, containers
+                , either, template-haskell, instance-control, directory
+                , filepath, HUnit, lens
+  
+source-repository head
+  type:       git
+  location:   git://github.com/lazac/references.git
+                     
 library
   exposed-modules:     Control.Reference
-                     , Control.Reference.TH.Records
-                     , Control.Reference.TH.Tuple
-                     , Control.Reference.Examples.TH
                      , Control.Reference.Representation
+                     , Control.Reference.Types
+                     , Control.Reference.Combinators
                      , Control.Reference.Operators
+                     , Control.Reference.Generators
                      , Control.Reference.Predefined
                      , Control.Reference.Predefined.Containers
                      , Control.Reference.Predefined.Containers.Tree
                      , Control.Reference.TupleInstances
                      , Control.Reference.InternalInterface
+                     , Control.Reference.TH.Records
+                     , Control.Reference.TH.Tuple
+                     , Control.Reference.Examples.TH
   build-depends:       base                 >= 4.6 && < 5 
-                     , text                 == 1.1.*
-                     , array                == 0.5.*
-                     , mtl                  == 2.2.*
-                     , transformers         == 0.4.*
-                     , containers           == 0.5.*
-                     , either               == 4.3.*
+                     , uniplate             >= 1.6 && < 2
+                     , text                 >= 1.1 && < 2
+                     , array                >= 0.5 && < 1
+                     , mtl                  >= 2.2 && < 3
+                     , transformers         >= 0.4 && < 1
+                     , containers           >= 0.5 && < 1
+                     , either               >= 4.3 && < 5
                      , template-haskell     >= 2.8 && < 3
-                     , instance-control     == 0.1.*
-                     , directory            == 1.2.*
-                     , filepath             == 1.3.*+                     , instance-control     >= 0.1 && < 1
+                     , directory            >= 1.2 && < 2
+                     , filepath             >= 1.3 && < 2
+                     
+