From badcce21bcbe982f2f693915f9d699db4a16cd8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Nowak?= Date: Wed, 29 Oct 2014 11:17:33 +0100 Subject: [PATCH] Version 0.1.0.0. --- .gitignore | 47 ++++++++++++ Control/Lens/Internal/SemiIso.hs | 39 ++++++++++ Control/Lens/SemiIso.hs | 123 +++++++++++++++++++++++++++++++ Data/SemiIsoFunctor.hs | 103 ++++++++++++++++++++++++++ LICENSE | 20 +++++ Setup.hs | 2 + semi-iso.cabal | 23 ++++++ 7 files changed, 357 insertions(+) create mode 100644 .gitignore create mode 100644 Control/Lens/Internal/SemiIso.hs create mode 100644 Control/Lens/SemiIso.hs create mode 100644 Data/SemiIsoFunctor.hs create mode 100644 LICENSE create mode 100644 Setup.hs create mode 100644 semi-iso.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..79257ef --- /dev/null +++ b/.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/ + diff --git a/Control/Lens/Internal/SemiIso.hs b/Control/Lens/Internal/SemiIso.hs new file mode 100644 index 0000000..4ff737d --- /dev/null +++ b/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 +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 diff --git a/Control/Lens/SemiIso.hs b/Control/Lens/SemiIso.hs new file mode 100644 index 0000000..a886ac7 --- /dev/null +++ b/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 +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" diff --git a/Data/SemiIsoFunctor.hs b/Data/SemiIsoFunctor.hs new file mode 100644 index 0000000..05da245 --- /dev/null +++ b/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 +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) diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d57e6ec --- /dev/null +++ b/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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/semi-iso.cabal b/semi-iso.cabal new file mode 100644 index 0000000..212d84a --- /dev/null +++ b/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 +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 \ No newline at end of file