mirror of
https://github.com/ilyakooo0/semi-iso-optics.git
synced 2024-09-11 07:55:36 +03:00
Version 0.1.0.0.
This commit is contained in:
commit
badcce21bc
47
.gitignore
vendored
Normal file
47
.gitignore
vendored
Normal file
@ -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/
|
||||
|
39
Control/Lens/Internal/SemiIso.hs
Normal file
39
Control/Lens/Internal/SemiIso.hs
Normal file
@ -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
|
123
Control/Lens/SemiIso.hs
Normal file
123
Control/Lens/SemiIso.hs
Normal file
@ -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"
|
103
Data/SemiIsoFunctor.hs
Normal file
103
Data/SemiIsoFunctor.hs
Normal file
@ -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)
|
20
LICENSE
Normal file
20
LICENSE
Normal file
@ -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.
|
23
semi-iso.cabal
Normal file
23
semi-iso.cabal
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user