Lev135

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

Lev135

Writing profunctor optics by the same template

All of the profunctor optics kind have the same, very simple, pattern:

type AnOptic p s t a b = p a b -> p s t
type Optic c s t a b = forall p. c p => AnOptic p s t a b

type Iso s t a b = Optic Profunctor s t a b

Lev135

{-# OPTIONS_GHC -Wall  #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

import Control.Monad
import Data.Bifunctor

type AnOptic p s t a b = p a b -> p s t

Lev135

Benchmark bench-trans-speed: RUNNING...
benchmarking 1/20 modify/pure/2000
time                 1.033 μs   (1.022 μs .. 1.052 μs)
                     0.991 R²   (0.981 R² .. 0.997 R²)
mean                 1.130 μs   (1.084 μs .. 1.207 μs)
std dev              182.7 ns   (129.1 ns .. 265.3 ns)
variance introduced by outliers: 95% (severely inflated)

benchmarking 1/20 modify/ParserT State/2000
time                 1.250 μs   (1.236 μs .. 1.264 μs)

Lev135

Monadic lens

So much has been written about lens and other optics in Haskell that these ideas are likely not very original. However, I'll try.

Initial problem

Let's say we have some recursive data type:

type Record = Map String Value
data Value = I Int | R Record
  deriving (Generic, Show)

Lev135

{-# LANGUAGE RankNTypes #-}

module LensM where

import Control.Applicative (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Contravariant (Contravariant)
import Data.Functor.Compose

class Functor f => MfaAms f where

Lev135

import Control.Monad ((>=>))
import Data.Map (Map)
import qualified Data.Map as M
import GHC.Generics (Generic)
import Optics

data MLens m s a = MLens
  { mview :: s -> m a
  , mset  :: a -> s -> m s
  }

Lev135

module Main where
import Data.Maybe (fromJust)

data Expr
  = Var String
  | Lam String Expr
  | App Expr Expr
  | Lit Int
  | Prim PrimOp Expr Expr
  | Let (String, Expr) Expr

Lev135

module Main where

import Data.Either.Extra (maybeToEither)

data Expr
  = Var String
  | Lam String Expr
  | App Expr Expr
  | Lit Int
  | Prim PrimOp Expr Expr

Lev135

{-# LANGUAGE GADTs         #-}
{-# LANGUAGE LambdaCase    #-}
{-# LANGUAGE TupleSections #-}

module Calc (
  Calc, call, runCalc, runCalcM, extractCalls,
  runCalcSortBy, runCalcSortOn, runCalcSort,
  contramapRes, mapInit, traverseInit
) where