polysemy-uncontrolled (empty) → 0.1.0.0

raw patch · 5 files changed

+212/−0 lines, 5 filesdep +basedep +polysemydep +polysemy-methodology

Dependencies added: base, polysemy, polysemy-methodology, polysemy-plugin

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +6/−0
• polysemy-uncontrolled.cabal +38/−0
• src/Polysemy/Uncontrolled.hs +133/−0

@@ -0,0 +1,5 @@+# Changelog for polysemy-uncontrolled++## v0.1.0.0++* An insane way to represent evil side effects in polysemy.

@@ -0,0 +1,30 @@+Copyright Daniel Firth (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,6 @@+# polysemy-uncontrolled++An insane way to represent pure side effects in polysemy.++This is for evil, people who are pure of heart should not+look in here.

@@ -0,0 +1,38 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           polysemy-uncontrolled+version:        0.1.0.0+synopsis:       Uncontrolled toy effect for polysemy.+category:       Polysemy+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      2020 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/homotopic-tech/polysemy-uncontrolled++library+  exposed-modules:+      Polysemy.Uncontrolled+  other-modules:+      Paths_polysemy_uncontrolled+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , polysemy >=1.3.0.0 && <1.5+    , polysemy-methodology >=0.1.0.0 && <0.2+    , polysemy-plugin+  default-language: Haskell2010

@@ -0,0 +1,133 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}++-- |+--   Module     : Polysemy.Uncontrolled+--   License    : MIT+--   Stability  : experimental+--+-- `Uncontrolled` is the evil dual of `Methodology`. Where a `Methodology b c`+-- represents a way to turn `b` into `c` in a controlled decomposition,+-- `Uncontrolled` represents a purely unknown side effect - that materialises+-- `b`s out of nowhere, and sends `c`s into the void where we have no knowledge+-- of what happens to them. This is equivalent to the combination of `Input`+-- and `Output` considered as a single unit.+--+-- This exists for symmetry with `Methodology` and out of curiosity, but should+-- be considered extremely dangerous. `Uncontrolled` can only ever be+-- reinterpreted as an equally or more severe side effect than the context in+-- which it's introduced. For experimentation though, this module might be fun+-- to see how much evil you can get away with.+--+-- There is a simple interpretation in the form of `runUncontrolledAsState`, as+-- well as ways of getting between `Uncontrolled` and `Input`/`Output`.+-- Combined with `teeMethodology` and `plugMethodology`, this may give you a+-- way to teleport state around your architecture.+module Polysemy.Uncontrolled+  ( -- * Definition+    Uncontrolled (..),+    send,+    receive,++    -- * Eliminators+    runUncontrolledAsState,+    runUncontrolledAsStateSem,+    runUncontrolledAsInputOutput,++    -- * Adapters+    adaptUncontrolledPure,+    adaptUncontrolledSem,++    -- * Coeliminators+    runInputAsUncontrolled,+    runOutputAsUncontrolled,+    runMethodologyAsUncontrolled,+  )+where++import Polysemy+import Polysemy.Input+import Polysemy.Methodology+import Polysemy.Output+import Polysemy.State++-- | An `Uncontrolled` generalises an unmanaged side effect.+data Uncontrolled c b m a where+  Send :: c -> Uncontrolled c b m ()+  Receive :: Uncontrolled c b m b++makeSem ''Uncontrolled++-- | Run an `Uncontrolled` as `State`, using a neutral element and accessors.+--+-- @since 0.1.0.0+runUncontrolledAsState :: forall s b c r a. Members '[State s] r => (c -> s) -> (s -> b) -> Sem (Uncontrolled c b ': r) a -> Sem r a+runUncontrolledAsState f g = runUncontrolledAsStateSem (pure . f) (pure . g)+{-# INLINE runUncontrolledAsState #-}++-- | Like `runUncontrolledAsState`, but uses monadic accessors. Using this would be completely insane. ;)+--+-- @since 0.1.0.0+runUncontrolledAsStateSem :: forall s b c r a. Members '[State s] r => (c -> Sem r s) -> (s -> Sem r b) -> Sem (Uncontrolled c b ': r) a -> Sem r a+runUncontrolledAsStateSem f g = interpret $ \case+  Send c -> f c >>= put+  Receive -> get >>= g+{-# INLINE runUncontrolledAsStateSem #-}++-- | Run an `Uncontrolled` as an `Input`/`Output` pair.+--+-- @since 0.1.0.0+runUncontrolledAsInputOutput :: Members '[Input b, Output c] r => Sem (Uncontrolled c b ': r) a -> Sem r a+runUncontrolledAsInputOutput = interpret $ \case+  Send c -> output c+  Receive -> input+{-# INLINE runUncontrolledAsInputOutput #-}++-- | Run an `Uncontrolled` as another kind of `Uncontrolled`, using pure functions to dimap from one to the other.+--+-- @since 0.1.0.0+adaptUncontrolledPure :: Members '[Uncontrolled c' b'] r => (c -> c') -> (b' -> b) -> Sem (Uncontrolled c b ': r) a -> Sem r a+adaptUncontrolledPure f g = adaptUncontrolledSem (pure . f) (pure . g)+{-# INLINE adaptUncontrolledPure #-}++-- | Like `adaptUncontrolledPure`, but with monadic adapters. If you use this I have no idea what you're trying to accomplish.+--+-- @since 0.1.0.0+adaptUncontrolledSem :: Members '[Uncontrolled c' b'] r => (c -> Sem r c') -> (b' -> Sem r b) -> Sem (Uncontrolled c b ': r) a -> Sem r a+adaptUncontrolledSem f g = interpret $ \case+  Send c -> f c >>= send+  Receive -> receive >>= g+{-# INLINE adaptUncontrolledSem #-}++-- | Run an `Input` as one side of an `Uncontrolled`.+--+-- @since 0.1.0.0+runInputAsUncontrolled :: Members '[Uncontrolled c b] r => Sem (Input b ': r) a -> Sem r a+runInputAsUncontrolled = interpret $ \case+  Input -> receive+{-# INLINE runInputAsUncontrolled #-}++-- | Run an `Output` as one side of an `Uncontrolled`.+--+-- @since 0.1.0.0+runOutputAsUncontrolled :: Members '[Uncontrolled c b] r => Sem (Output c ': r) a -> Sem r a+runOutputAsUncontrolled = interpret $ \case+  Output c -> send c+{-# INLINE runOutputAsUncontrolled #-}++-- | Run a `Methodology` as an `Uncontrolled` pure side effect.+--+-- @since 0.1.0.0+runMethodologyAsUncontrolled :: Members '[Uncontrolled b c] r => Sem (Methodology b c ': r) a -> Sem r a+runMethodologyAsUncontrolled = interpret $ \case+  Process b -> send b >> receive