Version 0.1.0.0.

.gitignore

@@ -0,0 +1,47 @@
+# Created by https://www.gitignore.io
+
+### Haskell ###
+dist
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+.virtualenv
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+cabal.config
+
+
+### Emacs ###
+# -*- mode: gitignore; -*-
+*~
+\#*\#
+/.emacs.desktop
+/.emacs.desktop.lock
+*.elc
+auto-save-list
+tramp
+.\#*
+
+# Org-mode
+.org-id-locations
+*_archive
+
+# flymake-mode
+*_flymake.*
+
+# eshell files
+/eshell/history
+/eshell/lastdir
+
+# elpa packages
+/elpa/
+
+# reftex files
+*.rel
+
+# AUCTeX auto folder
+/auto/
+

Control/Lens/Internal/SemiIso.hs

@@ -0,0 +1,39 @@
+{- |
+Module      :  Data.Lens.Internal.SemiIso
+Description :  Internals of a SemiIso.
+Copyright   :  (c) Paweł Nowak
+License     :  MIT
+
+Maintainer  :  Paweł Nowak <pawel834@gmail.com>
+Stability   :  experimental
+-}
+module Control.Lens.Internal.SemiIso where
+
+import Control.Monad
+import Data.Profunctor
+
+-- | Type used internally to access 'SemiIso'.
+--
+-- Continues the naming tradition of @lens@.
+data Barter s t a b = Barter (a -> Either String s) (t -> Either String b)
+
+instance Profunctor (Barter s t) where
+    lmap f (Barter l r) = Barter (l . f) r
+    rmap f (Barter l r) = Barter l (fmap f . r)
+
+instance Choice (Barter s t) where
+    left' (Barter as st) = Barter 
+        (either as (\_ -> Left "partial iso failed")) (fmap Left . st)
+    right' (Barter as st) = Barter 
+        (either (\_ -> Left "partial iso failed") as) (fmap Right . st)
+
+-- | Provides a profunctor the ability to fail with an error message.
+--
+-- This class could use some laws. It is certainly a bit ad-hoc.
+class Profunctor p => Failure p where
+    tie :: p a (Either String b) -> p a b
+    attach :: p a b -> p (Either String a) b
+
+instance Failure (Barter s t) where
+    tie (Barter f g) = Barter f (join . g)
+    attach (Barter f g) = Barter (>>= f) g

Control/Lens/SemiIso.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TupleSections #-}
+{- |
+Module      :  Data.Lens.SemiIso
+Description :  Semi-isomorphisms.
+Copyright   :  (c) Paweł Nowak
+License     :  MIT
+
+Maintainer  :  Paweł Nowak <pawel834@gmail.com>
+Stability   :  experimental
+
+Semi-isomorphisms were motivated by reversible parsing/pretty printing. For example
+we can map a number 12 to a string "12" (and the other way around). But the isomorphism
+is partial - we cannot map the string "forty-two" to a number.
+
+Another example: when parsing a list of numbers like "12_53___42" we want to skip underscores
+between numbers (and forget about them). During pretty printing we have to decide how many
+underscores should we insert between numbers. Let's say we insert a single underscore. But now
+@prettyPrint (parse "12_53___42") = "12_53_42"@ and not "12_53___42". We have to weaken
+isomorphism laws to allow such semi-iso. Notice that
+
+> parse (prettyPrint (parse "12_53___42"))       = parse "12_53___42"
+> prettyPrint (parse (prettyPrint [12, 53, 42])) = prettyPrint [12, 53, 42]
+
+Our semi-isomorphisms will obey weakened laws:
+
+> apply i   >=> unapply i >=> apply i   = apply i
+> unapply i >=> apply i   >=> unapply i = unapply i
+
+When you see an "Either String a", the String is usually an error message.
+
+Disclaimer: the name "semi-isomorphism" is fictitious and made up for this library. 
+Any resemblance to known mathematical objects of the same name is purely coincidental.
+-}
+module Control.Lens.SemiIso (
+    -- * Semi-isomorphism types.
+    SemiIso,
+    SemiIso',
+    ASemiIso,
+    ASemiIso',
+    
+    -- * Constructing semi-isos.
+    semiIso,
+
+    -- * Consuming semi-isos.
+    withSemiIso,
+    fromSemi,
+    apply,
+    unapply,
+    
+    -- * Common semi-isomorphisms and isomorphisms.
+    unit,
+    swapped,
+    associated,
+    constant
+    ) where
+
+import Control.Lens.Internal.SemiIso
+import Control.Lens.Iso
+import Data.Functor.Identity
+import Data.Traversable
+
+-- | A semi-isomorphism is a partial isomorphism with weakened laws.
+-- 
+-- Should satisfy laws:
+-- 
+-- > apply i   >=> unapply i >=> apply i   = apply i
+-- > unapply i >=> apply i   >=> unapply i = unapply i
+--
+-- Every 'Prism' is a 'SemiIso'.
+-- Every 'Iso' is a 'Prism'.
+type SemiIso s t a b = forall p f. (Failure p, Traversable f) => p a (f b) -> p s (f t)
+
+-- | Non-polymorphic variant of 'SemiIso'.
+type SemiIso' s a = SemiIso s s a a
+
+-- | When you see this as an argument to a function, it expects a 'SemiIso'.
+type ASemiIso s t a b = Barter a b a (Identity b) -> Barter a b s (Identity t)
+
+-- | When you see this as an argument to a function, it expects a 'SemiIso''.
+type ASemiIso' s a = ASemiIso s s a a
+
+-- | Constructs a semi isomorphism from a pair of functions that can
+-- fail with an error message.
+semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b
+semiIso sa bt = tie . dimap sa (sequenceA . fmap bt) . attach
+
+-- | Extracts the two functions that characterize the 'SemiIso'.
+withSemiIso :: ASemiIso s t a b 
+            -> ((s -> Either String a) -> (b -> Either String t) -> r) 
+            -> r
+withSemiIso ai k = case ai (Barter Right (Right . Identity)) of
+                        Barter sa bt -> k sa (rmap (runIdentity . sequenceA) bt)
+
+-- | Applies the 'SemiIso'.
+apply :: ASemiIso s t a b -> s -> Either String a
+apply ai = withSemiIso ai $ \l _ -> l
+
+-- | Applies the 'SemiIso' in the opposite direction.
+unapply :: ASemiIso s t a b -> b -> Either String t
+unapply ai = withSemiIso ai $ \_ r -> r
+
+-- | Reverses a 'SemiIso'.
+fromSemi :: ASemiIso s t a b -> SemiIso b a t s
+fromSemi ai = withSemiIso ai $ \l r -> semiIso r l
+
+-- | A trivial isomorphism between a and (a, ()).
+unit :: Iso' a (a, ())
+unit = iso (, ()) fst
+
+-- | Products are associative.
+associated :: Iso' (a, (b, c)) ((a, b), c)
+associated = iso (\(a, (b, c)) -> ((a, b), c)) (\((a, b), c) -> (a, (b, c)))
+
+-- | \-> Always returns the argument.
+--
+-- \<- Filters out all values not equal to the argument.
+constant :: Eq a => a -> SemiIso' () a
+constant x = semiIso f g
+  where
+    f _ = Right x
+    g y | x == y    = Right ()
+        | otherwise = Left "constant: not equal"

Data/SemiIsoFunctor.hs

@@ -0,0 +1,103 @@
+{- |
+Module      :  Data.SemiIsoFunctor
+Description :  Functors from the category of semi-isomoprihsms to Hask.
+Copyright   :  (c) Paweł Nowak
+License     :  MIT
+
+Maintainer  :  Paweł Nowak <pawel834@gmail.com>
+Stability   :  experimental
+
+Defines a functor from the category of semi-isomoprihsms to Hask.
+
+The most interesting property of that class is that it can be
+instantiated by both covariant (like Parser) and contravariant (like Printer) 
+functors. Therefore it can be used as a common interface to unify
+parsing and pretty printing.
+
+Operator names are up to bikeshedding :)
+-}
+module Data.SemiIsoFunctor where
+
+import Control.Lens.Cons
+import Control.Lens.Empty
+import Control.Lens.SemiIso
+
+infixl 3 /|/
+infixl 4 /$/
+infixl 5 /*/, /*, */
+
+-- | A functor from the category of semi-isomorphisms to Hask.
+--
+-- It is both covariant and contravariant in its single arugment.
+--
+-- The contravariant map is used by default to provide compatibility with 
+-- Prisms (otherwise you would have to reverse them in most cases).
+--
+-- Instances should satisfy laws:
+-- 
+-- > simap id      = id
+-- > simap (f . g) = simap g . simap f
+-- > simap         = simapCo . fromSemi
+-- > simapCo       = simap   . fromSemi
+class SemiIsoFunctor f where
+    -- | The contravariant map.
+    simap :: ASemiIso' a b -> f b -> f a
+    simap = simapCo . fromSemi
+    
+    -- | The covariant map.
+    simapCo :: ASemiIso' a b -> f a -> f b
+    simapCo = simap . fromSemi
+    
+    {-# MINIMAL simap | simapCo #-}
+
+-- | A infix operator for 'simap'.
+(/$/) :: SemiIsoFunctor f => ASemiIso' a b -> f b -> f a
+(/$/) = simap
+
+-- | Equivalent of 'Applicative' for 'SemiIsoFunctor'.
+--
+-- However, this class implements uncurried application, unlike 
+-- 'Control.Applicative' which gives you curried application.
+--
+-- Instances should satisfy laws:
+-- 
+-- > TODO (they should be fine)
+class SemiIsoFunctor f => SemiIsoApply f where
+    sipure :: ASemiIso' a () -> f a
+    (/*/) :: f a -> f b -> f (a, b)
+
+    (/*)  :: f a -> f () -> f a
+    f /* g = unit /$/ f /*/ g
+
+    (*/)  :: f () -> f b -> f b
+    f */ g = unit . swapped /$/ f /*/ g
+
+    {-# MINIMAL sipure, (/*/) #-}
+
+-- | Equivalent of 'Alternative' for 'SemiIsoFunctor'.
+--
+-- @f a@ should form a monoid with identity 'siempty' and binary
+-- operation '/|/'.
+class SemiIsoApply f => SemiIsoAlternative f where
+    siempty :: f a
+    (/|/) :: f a -> f a -> f a
+
+    sisome :: f a -> f [a]
+    sisome v = _Cons /$/ v /*/ simany v
+
+    simany :: f a -> f [a]
+    simany v = sisome v /|/ sipure _Empty
+
+    {-# MINIMAL siempty, (/|/) #-}
+
+-- | Equivalent of 'sequence'.
+--
+-- Note that it is not possible to write sequence_, because
+-- you cannot void a SemiIsoFunctor.
+sisequence :: SemiIsoApply f => [f a] -> f [a]
+sisequence [] = sipure _Empty
+sisequence (x:xs) = _Cons /$/ x /*/ sisequence xs
+
+-- | Equivalent of 'replicateM'.
+sireplicate :: SemiIsoApply f => Int -> f a -> f [a]
+sireplicate n f = sisequence (replicate n f)

LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2014 Paweł Nowak
+
+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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

semi-iso.cabal

@@ -0,0 +1,23 @@
+name:                semi-iso
+version:             0.1.0.0
+synopsis:            Weakened partial isomorphisms that work with lenses.
+description:         Semi-isomorphisms are partial isomorphisms with weakened iso laws.
+                     And they work with Iso and Prism from @lens@!
+                     .
+                     See first "Control.Lens.SemiIso" for semi-isomoprhisms.
+                     After that look at "Data.SemiIsoFunctor".
+license:             MIT
+license-file:        LICENSE
+author:              Paweł Nowak
+maintainer:          Paweł Nowak <pawel834@gmail.com>
+copyright:           Paweł Nowak 2014
+category:            Control, Data
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Control.Lens.SemiIso
+                       Control.Lens.Internal.SemiIso
+                       Data.SemiIsoFunctor
+  build-depends:       base >=4.7 && <4.8, profunctors, transformers, lens
+  default-language:    Haskell2010