├── .gitignore ├── .travis.yml ├── LICENSE ├── Lens.idr ├── default.nix └── lens.ipkg /.gitignore: -------------------------------------------------------------------------------- 1 | *.ibc -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: nix 2 | script: nix-shell -A lens --command "idris --build lens.ipkg" 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, The Idris Community 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | 3. None of the names of the copyright holders may be used to endorse 13 | or promote products derived from this software without specific 14 | prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ``AS IS'' AND ANY 17 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 18 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 19 | PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE 20 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 21 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 22 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 23 | BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 24 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 25 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 26 | IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Lens.idr: -------------------------------------------------------------------------------- 1 | module Lens 2 | 3 | import Control.Category 4 | 5 | %access public export 6 | 7 | -- Store comonad 8 | 9 | data Store s a = MkStore (s -> a) s 10 | 11 | interface Functor w => Comonad (w : Type -> Type) where 12 | extract : w a -> a 13 | extend : (w a -> b) -> w a -> w b 14 | 15 | interface Comonad w => VerifiedComonad (w : Type -> Type) where 16 | comonadLaw1 : (wa : w a) -> 17 | extend extract wa = wa 18 | comonadLaw2 : (f : w a -> b) -> 19 | (wa : w a) -> 20 | extract (extend f wa) = f wa 21 | comonadLaw3 : (f : w b -> c) -> 22 | (g : w a -> b) -> 23 | (wa : w a) -> 24 | extend f (extend g wa) = extend (\d => f (extend g d)) wa 25 | 26 | Functor (Store s) where 27 | map f (MkStore g a) = MkStore (f . g) a 28 | 29 | Comonad (Store s) where 30 | extract (MkStore f a) = f a 31 | extend f (MkStore g a) = MkStore (\b => f (MkStore g b)) a 32 | 33 | -- VerifiedComonad (Store s) where 34 | -- comonadLaw1 (MkStore f a) = ?storeIdentityProof 35 | -- comonadLaw2 f (MkStore g a) = Refl 36 | -- comonadLaw3 f g (MkStore h a) = Refl 37 | 38 | -- -- TODO: This is evil. 39 | -- -- Supposedly (jonsterling) this definition used to work without the believe_me. 40 | -- private 41 | -- eta : (f : a -> b) -> f = (\c => f c) 42 | -- eta g = believe_me Refl {g} 43 | 44 | -- storeIdentityProof = proof 45 | -- intros 46 | -- rewrite eta f 47 | -- trivial 48 | 49 | pos : Store s a -> s 50 | pos (MkStore _ s) = s 51 | 52 | peek : s -> Store s a -> a 53 | peek s (MkStore f _) = f s 54 | 55 | peeks : (s -> s) -> Store s a -> a 56 | peeks f (MkStore g s) = g (f s) 57 | 58 | -- Lenses 59 | 60 | data Lens a b = MkLens (a -> Store b a) 61 | 62 | Category Lens where 63 | id = MkLens (MkStore id) 64 | (.) (MkLens f) (MkLens g) = MkLens (\a => case g a of 65 | MkStore ba b => case f b of 66 | MkStore cb c => MkStore (Prelude.Basics.(.) ba cb) c) 67 | 68 | lens : (a -> b) -> (b -> a -> a) -> Lens a b 69 | lens f g = MkLens (\a => MkStore (\b => g b a) (f a)) 70 | 71 | iso : (a -> b) -> (b -> a) -> Lens a b 72 | iso f g = MkLens (\a => MkStore g (f a)) 73 | 74 | getL : Lens a b -> a -> b 75 | getL (MkLens f) a = pos (f a) 76 | 77 | setL : Lens a b -> b -> a -> a 78 | setL (MkLens f) b = peek b . f 79 | 80 | modL : Lens a b -> (b -> b) -> a -> a 81 | modL (MkLens f) g = peeks g . f 82 | 83 | mergeL : Lens a c -> Lens b c -> Lens (Either a b) c 84 | mergeL (MkLens f) (MkLens g) = MkLens $ either (\a => map Left $ f a) 85 | (\b => map Right $ g b) 86 | 87 | infixr 0 ^$ 88 | (^$) : Lens a b -> a -> b 89 | (^$) = getL 90 | 91 | infixr 4 ^= 92 | (^=) : Lens a b -> b -> a -> a 93 | (^=) = setL 94 | 95 | infixr 4 ^%= 96 | (^%=) : Lens a b -> (b -> b) -> a -> a 97 | (^%=) = modL 98 | 99 | fstLens : Lens (a,b) a 100 | fstLens = MkLens $ \(a,b) => MkStore (\ a' => (a', b)) a 101 | 102 | sndLens : Lens (a,b) b 103 | sndLens = MkLens $ \(a,b) => MkStore (\ b' => (a, b')) b 104 | 105 | -- Partial lenses 106 | 107 | data PLens a b = MkPLens (a -> Maybe (Store b a)) 108 | 109 | Category PLens where 110 | id = MkPLens (Just . MkStore id) 111 | (.) (MkPLens f) (MkPLens g) = MkPLens (\a => do 112 | MkStore wba b <- g a 113 | MkStore wcb c <- f b 114 | pure (MkStore (wba . wcb) c)) 115 | 116 | plens : (a -> Either a (Store b a)) -> PLens a b 117 | plens f = MkPLens $ either (const Nothing) Just . f 118 | 119 | getPL : PLens a b -> a -> Maybe b 120 | getPL (MkPLens f) a = map pos (f a) 121 | 122 | justPL : PLens (Maybe a) a 123 | justPL = MkPLens (\ma => do 124 | a <- ma 125 | pure (MkStore Just a)) 126 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | # This is used in the Travis build to install the Idris compiler. 2 | let 3 | pkgs = import {}; 4 | stdenv = pkgs.stdenv; 5 | in { 6 | lens = stdenv.mkDerivation { 7 | name = "lens"; 8 | src = ./.; 9 | buildInputs = with pkgs; [ haskellPackages.idris gmp ]; 10 | }; 11 | } 12 | -------------------------------------------------------------------------------- /lens.ipkg: -------------------------------------------------------------------------------- 1 | package lens 2 | 3 | modules = Lens 4 | --------------------------------------------------------------------------------