From 594763d8ceac4a48f1c5cc5c63700c9fc488d48d Mon Sep 17 00:00:00 2001 From: Sanchayan Maity Date: Sun, 12 Jan 2020 11:14:06 +0530 Subject: [PATCH] IHaskell notebook on Isos in Optics Signed-off-by: Sanchayan Maity --- .gitignore | 1 + isos.ipynb | 2153 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 2154 insertions(+) create mode 100644 .gitignore create mode 100644 isos.ipynb diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..763513e --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.ipynb_checkpoints diff --git a/isos.ipynb b/isos.ipynb new file mode 100644 index 0000000..ea18e0c --- /dev/null +++ b/isos.ipynb @@ -0,0 +1,2153 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 50, + "metadata": {}, + "outputs": [], + "source": [ + "import Control.Lens\n", + "import Data.Text\n", + "import qualified Data.Text as T\n", + "import qualified Control.Lens as L\n", + "\n", + "to :: String -> T.Text\n", + "to = T.pack\n", + "\n", + "from :: T.Text -> String\n", + "from = T.unpack" + ] + }, + { + "cell_type": "code", + "execution_count": 38, + "metadata": {}, + "outputs": [], + "source": [ + "-- Transformations are completely reversible\n", + "\n", + "pack . unpack = id\n", + "unpack . pack = id" + ] + }, + { + "cell_type": "code", + "execution_count": 39, + "metadata": {}, + "outputs": [], + "source": [ + "-- Generally for all isomorphisms\n", + "\n", + "to . from = id\n", + "from . to = id" + ] + }, + { + "cell_type": "code", + "execution_count": 41, + "metadata": { + "scrolled": true + }, + "outputs": [ + { + "data": { + "text/html": [ + "iso :: forall (p :: * -> * -> *) (f :: * -> *) s a b t. (Profunctor p, Functor f) => (s -> a) -> (b -> t) -> p a (f b) -> p s (f t)" + ], + "text/plain": [ + "iso :: forall (p :: * -> * -> *) (f :: * -> *) s a b t. (Profunctor p, Functor f) => (s -> a) -> (b -> t) -> p a (f b) -> p s (f t)" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- iso :: (s -> a) -> (b -> t) -> Iso s t a b\n", + "-- Iso' s a where s ~ a and b ~ t\n", + "-- ~ means the types are equal\n", + "\n", + ":t iso" + ] + }, + { + "cell_type": "code", + "execution_count": 42, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"Ay, Caramba!\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "x :: Text" + ], + "text/plain": [ + "x :: Text" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "(#) :: forall t b. AReview t b -> b -> t" + ], + "text/plain": [ + "(#) :: forall t b. AReview t b -> b -> t" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Sufferin' Succotash\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "y :: String" + ], + "text/plain": [ + "y :: String" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "L.from :: forall (p :: * -> * -> *) (f :: * -> *) s t a b. (Profunctor p, Functor f) => AnIso s t a b -> p t (f s) -> p b (f a)" + ], + "text/plain": [ + "L.from :: forall (p :: * -> * -> *) (f :: * -> *) s t a b. (Profunctor p, Functor f) => AnIso s t a b -> p t (f s) -> p b (f a)" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Good grief\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "x :: Text" + ], + "text/plain": [ + "x :: Text" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Good grief\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "y :: String" + ], + "text/plain": [ + "y :: String" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "packed :: Iso' String T.Text\n", + "packed = iso to' from'\n", + " where \n", + " to' :: String -> T.Text\n", + " to' = T.pack\n", + " from' :: T.Text -> String\n", + " from' = T.unpack\n", + " \n", + "let x = (\"Ay, Caramba!\" :: String) ^. packed\n", + "x\n", + ":t x\n", + "\n", + "-- # is review. Reviewing an iso returns it's inverse\n", + "-- We typically don't review iso's however, they have a different way of running things backwards\n", + "-- OverloadedStrings extension is required here else the next line will error out\n", + "\n", + ":t (#)\n", + "let y = packed # (\"Sufferin' Succotash\" :: T.Text)\n", + "y\n", + ":t y\n", + "\n", + ":t L.from\n", + "\n", + "-- from :: Iso s t a b -> Iso b a t s\n", + "-- Simple form\n", + "-- from :: Iso' s a -> Iso' a s\n", + "\n", + "-- (#) :: forall t b. AReview t b -> (b -> t)\n", + "-- review returns a function and thus can be composed in an optics path\n", + "-- from returns a whole new Iso\n", + "\n", + "-- We can use from to flip existing Isos\n", + "\n", + "let x = (\"Good grief\" :: String) ^. packed\n", + "x\n", + ":t x\n", + "\n", + "let y = (\"Good grief\" :: T.Text) ^. L.from packed\n", + "y\n", + ":t y\n", + "\n", + "-- unpacked :: Iso' T.Text String\n", + "-- unpacked = from packed" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Modification under an Isomorphism\n", + "\n", + "* What does it mean to modify something through an Iso?\n", + "* Convert the data through the Iso, run the modification and then convert it back" + ] + }, + { + "cell_type": "code", + "execution_count": 43, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"Sand on a pedestal\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Sand on a pedestal\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "str2 :: String" + ], + "text/plain": [ + "str2 :: String" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "let str = \"Idol on a pedestal\" :: String\n", + "str & packed %~ T.replace \"Idol\" \"Sand\"\n", + "\n", + "-- over ~ %~\n", + "let str2 = over packed (T.replace \"Idol\" \"Sand\") str\n", + "str2\n", + ":t str2" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Isos are composable with other optics" + ] + }, + { + "cell_type": "code", + "execution_count": 60, + "metadata": {}, + "outputs": [], + "source": [ + "{-# LANGUAGE OverloadedStrings #-}\n", + "\n", + "import Data.Char as C\n", + "import Control.Lens as L\n", + "import Data.Text.Lens as TL\n", + "\n", + "let txt = \"Lorem Ipsum\" :: T.Text\n", + "\n", + "--txt & (from packed) . (traversed %~ C.toUpper)" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Varieties of Isomorphisms" + ] + }, + { + "cell_type": "code", + "execution_count": 77, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "[1,2,3]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[3]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "swapped :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *) (f :: * -> *) b a d c. (Swapped p1, Profunctor p2, Functor f) => p2 (p1 b a) (f (p1 d c)) -> p2 (p1 a b) (f (p1 c d))" + ], + "text/plain": [ + "swapped :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *) (f :: * -> *) b a d c. (Swapped p1, Profunctor p2, Functor f) => p2 (p1 b a) (f (p1 d c)) -> p2 (p1 a b) (f (p1 c d))" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "(\"Pride\",\"Fall\")" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Left \"Field\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "{-# LANGUAGE RankNTypes #-}\n", + "\n", + "import Data.List as List\n", + "\n", + "-- involuted :: (a -> a) -> Iso' a a\n", + "-- involuted f = iso f f\n", + "\n", + "-- reversed :: Iso' [a] [a]\n", + "-- reversed = involuted List.reverse\n", + "\n", + "List.reverse . List.reverse $ [1, 2, 3]\n", + "\n", + "[1, 2, 3] & reversed %~ List.drop 1\n", + "\n", + "[1, 2, 3] & reversed %~ List.take 1\n", + "\n", + "-- [1, 2, 3, 4] ^.. reversed . takingWhile (> 2) traversed\n", + "\n", + "-- swapped :: Iso' (a, b) (b a)\n", + ":t swapped\n", + "\n", + "(\"Fall\", \"Pride\") ^. swapped\n", + "\n", + "-- swapped :: (Bifunctor p, Swapped p) => Iso (p a b) (p c d) (p b a) (p d c)\n", + "\n", + "Right \"Field\" ^. swapped" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Some more examples" + ] + }, + { + "cell_type": "code", + "execution_count": 82, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "flipped :: forall (p :: * -> * -> *) (f :: * -> *) b a c b' a' c'. (Profunctor p, Functor f) => p (b -> a -> c) (f (b' -> a' -> c')) -> p (a -> b -> c) (f (a' -> b' -> c'))" + ], + "text/plain": [ + "flipped :: forall (p :: * -> * -> *) (f :: * -> *) b a c b' a' c'. (Profunctor p, Functor f) => p (b -> a -> c) (f (b' -> a' -> c')) -> p (a -> b -> c) (f (a' -> b' -> c'))" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"BA\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "curried :: forall (p :: * -> * -> *) (f1 :: * -> *) a b c d e f2. (Profunctor p, Functor f1) => p (a -> b -> c) (f1 (d -> e -> f2)) -> p ((a, b) -> c) (f1 ((d, e) -> f2))" + ], + "text/plain": [ + "curried :: forall (p :: * -> * -> *) (f1 :: * -> *) a b c d e f2. (Profunctor p, Functor f1) => p (a -> b -> c) (f1 (d -> e -> f2)) -> p ((a, b) -> c) (f1 ((d, e) -> f2))" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "uncurried :: forall (p :: * -> * -> *) (f1 :: * -> *) a b c d e f2. (Profunctor p, Functor f1) => p ((a, b) -> c) (f1 ((d, e) -> f2)) -> p (a -> b -> c) (f1 (d -> e -> f2))" + ], + "text/plain": [ + "uncurried :: forall (p :: * -> * -> *) (f1 :: * -> *) a b c d e f2. (Profunctor p, Functor f1) => p ((a, b) -> c) (f1 ((d, e) -> f2)) -> p (a -> b -> c) (f1 (d -> e -> f2))" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "3" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "-10" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "20" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "150" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- flipped :: Iso' (a -> b -> c) (b -> a -> c)\n", + "\n", + ":t flipped\n", + "\n", + "let (++?) = (++) ^. flipped\n", + "\"A\" ++? \"B\"\n", + "\n", + "-- curried :: Iso' ((a, b) -> c) (a -> b -> c)\n", + "-- uncurried :: Iso' (a -> b -> c) ((a, b) -> c)\n", + "\n", + ":t curried\n", + ":t uncurried\n", + "\n", + "let addTuple = (+) ^. uncurried\n", + "addTuple (1, 2)\n", + "\n", + "import Numeric.Lens\n", + "\n", + "10 ^. negated\n", + "\n", + "over negated (+10) 30\n", + "\n", + "100 ^. adding 50" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Composing Isos" + ] + }, + { + "cell_type": "code", + "execution_count": 105, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "unpacked :: forall t (p :: * -> * -> *) (f :: * -> *). (IsText t, Profunctor p, Functor f) => p String (f String) -> p t (f t)" + ], + "text/plain": [ + "unpacked :: forall t (p :: * -> * -> *) (f :: * -> *). (IsText t, Profunctor p, Functor f) => p String (f String) -> p t (f t)" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "ename": "", + "evalue": "", + "output_type": "error", + "traceback": [ + ":1:43: error:\n • Couldn't match type ‘Char’ with ‘Bool’\n Expected type: Char -> Bool\n Actual type: Bool -> Bool\n • In the first argument of ‘T.takeWhile’, namely ‘(not . isSpace)’\n In the second argument of ‘(%~)’, namely ‘T.takeWhile (not . isSpace)’\n In the second argument of ‘(&)’, namely ‘unpacked . reversed %~ T.takeWhile (not . isSpace)’" + ] + } + ], + "source": [ + "let txt = \"Winter is coming\" :: T.Text\n", + "\n", + ":t unpacked \n", + "\n", + "-- txt ^. unpacked . reversed\n", + "\n", + "-- txt & unpacked . reversed %~ T.takeWhile (not . isSpace)" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Projecting Isos" + ] + }, + { + "cell_type": "code", + "execution_count": 106, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "mapping :: forall (p :: * -> * -> *) (f1 :: * -> *) (g :: * -> *) (f2 :: * -> *) s t a b. (Profunctor p, Functor f1, Functor g, Functor f2) => AnIso s t a b -> p (f1 a) (f2 (g b)) -> p (f1 s) (f2 (g t))" + ], + "text/plain": [ + "mapping :: forall (p :: * -> * -> *) (f1 :: * -> *) (g :: * -> *) (f2 :: * -> *) s t a b. (Profunctor p, Functor f1, Functor g, Functor f2) => AnIso s t a b -> p (f1 a) (f2 (g b)) -> p (f1 s) (f2 (g t))" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "contramapping :: forall (f1 :: * -> *) (p :: * -> * -> *) (f2 :: * -> *) s t a b. (Contravariant f1, Profunctor p, Functor f2) => AnIso s t a b -> p (f1 s) (f2 (f1 t)) -> p (f1 a) (f2 (f1 b))" + ], + "text/plain": [ + "contramapping :: forall (f1 :: * -> *) (p :: * -> * -> *) (f2 :: * -> *) s t a b. (Contravariant f1, Profunctor p, Functor f2) => AnIso s t a b -> p (f1 s) (f2 (f1 t)) -> p (f1 a) (f2 (f1 b))" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- Isos can be lifted into other structures\n", + "\n", + "mapping' :: Functor f => Iso' s a -> Iso' (f s) (f a)\n", + "mapping' i = iso (fmap (view i)) (fmap (review i))\n", + "\n", + "-- mapping :: (Functor f, Functor g)\n", + "-- => Iso s t a b -> Iso (f s) (g t) (f a) (g b)\n", + "\n", + ":t mapping\n", + "\n", + "-- contramapping :: Contravariant f\n", + "-- => Iso s t a b -> Iso (f a) (f b) (f s) (f t)\n", + "\n", + "-- bimapping :: (Bifunctor f, Bifunctor g)\n", + "-- => Iso s t a b -> Iso s' t' a' b'\n", + "-- -> Iso (f s s') (g t t') (f a a') (g b b')\n", + " \n", + "-- dimapping :: (Profunctor p, Profunctor q)\n", + "-- => Iso s t a b -> Iso s' t' a' b'\n", + "-- -> Iso (p a s') (q b t') (p s a') (q t b')\n", + "\n", + "-- Even more simplified signatures\n", + "\n", + "-- contramapping :: (Contravariant f)\n", + "-- => Iso' s a -> Iso (f a) (f s)\n", + "\n", + "-- bimapping :: (Bifunctor f)\n", + "-- => Iso' s a -> Iso' s' a'\n", + "-- -> Iso' (f s s') (f a a')\n", + "\n", + "-- dimapping :: (Profunctor p)\n", + "-- => Iso' s a -> Iso' s' a'\n", + "-- -> Iso' (p a s') (p s a')" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Isos and newtypes" + ] + }, + { + "cell_type": "code", + "execution_count": 133, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "coerce :: forall a b. Coercible a b => a -> b" + ], + "text/plain": [ + "coerce :: forall a b. Coercible a b => a -> b" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Email {_email = \"joe@example.com\"}" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "UserID \"joe@example.com\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "coerced :: forall (p :: * -> * -> *) (f :: * -> *) s a t b. (Profunctor p, Functor f, Coercible s a, Coercible t b) => p a (f b) -> p s (f t)" + ], + "text/plain": [ + "coerced :: forall (p :: * -> * -> *) (f :: * -> *) s a t b. (Profunctor p, Functor f, Coercible s a, Coercible t b) => p a (f b) -> p s (f t)" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Email {_email = \"moc.elpmaxe@eoj\"}" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "{-# LANGUAGE TemplateHaskell #-}\n", + "\n", + "import Data.Coerce (coerce)\n", + "import Data.Char as C\n", + "\n", + ":t coerce\n", + "\n", + "newtype Email = Email {_email :: String}\n", + " deriving (Show)\n", + "makeLenses ''Email\n", + "\n", + "coerce (\"joe@example.com\" :: String) :: Email\n", + "\n", + "coerce (Email \"joe@example.com\") :: UserID\n", + "\n", + "-- coerced :: (Coercible s a, Coercible t b) => Iso s t a b\n", + "\n", + ":t coerced\n", + "\n", + "over coerced\n", + " (Prelude.reverse :: String -> String)\n", + " (Email \"joe@example.com\") :: Email\n", + " \n", + "\n", + "-- Email \"joe@example.com\" & email . (traversed %~ C.toUpper)" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Newtype wrapper Isos" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "metadata": {}, + "outputs": [], + "source": [ + "-- _Wrapped' :: Wrapped s => Iso' s (Unwrapped s)\n", + "-- _Unwrapped' :: Wrapped s => Iso' (Unwrapped s) s\n", + "\n", + "-- Not automatically derived." + ] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Haskell", + "language": "haskell", + "name": "haskell" + }, + "language_info": { + "codemirror_mode": "ihaskell", + "file_extension": ".hs", + "name": "haskell", + "pygments_lexer": "Haskell", + "version": "8.6.5" + } + }, + "nbformat": 4, + "nbformat_minor": 2 +}