diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright © 2018-2021 Athae Eredh Siniath and Others + +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/core-effect-effectful.cabal b/core-effect-effectful.cabal new file mode 100644 --- /dev/null +++ b/core-effect-effectful.cabal @@ -0,0 +1,47 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.1. +-- +-- see: https://github.com/sol/hpack + +name: core-effect-effectful +version: 0.0.0.4 +synopsis: Interoperability with the effectful effects system +description: This is part of a library to help build command-line programs, both tools and + longer-running daemons. + . + This package adds wrappers around the __effectful__ library, providing an + implmentation of a ProgramE τ effect wrapping the Program τ monad from + __core-program__ so that applications needing to use a complicated effect + system can still access top-level program utilities such as concurrency, + logging, and telemetry. +category: System +stability: experimental +homepage: https://github.com/aesiniath/unbeliever#readme +bug-reports: https://github.com/aesiniath/unbeliever/issues +author: Juan Raphael Diaz Simões +maintainer: Andrew Cowie +copyright: © 2023- Athae Eredh Siniath and Others +license: MIT +license-file: LICENSE +build-type: Simple +tested-with: + GHC == 9.2.4 + +source-repository head + type: git + location: https://github.com/aesiniath/unbeliever + +library + exposed-modules: + Core.Effect.Effectful + hs-source-dirs: + lib + ghc-options: -Wall -Wwarn -fwarn-tabs + build-depends: + base >=4.11 && <5 + , core-data + , core-program >=0.6.2 + , core-text + , effectful-core + default-language: Haskell2010 diff --git a/lib/Core/Effect/Effectful.hs b/lib/Core/Effect/Effectful.hs new file mode 100644 --- /dev/null +++ b/lib/Core/Effect/Effectful.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_HADDOCK prune #-} + +{- | +Effect systems are being actively explored as ways to structure Haskell +programs. This package provides experimental support for the __effectful__ +effect system. + +This module introcuces a new effect, 'ProgramE', which plumbs the current +program context into the effect system. By calling 'runProgramE' to add the +'ProgramE' effect to the current list of in-scope effects you can then use +'withProgram'' to run a 'Program' action. The more general 'withProgram' gives +you an unlifting function to return back to the effect system so you can +continue processing within your effects stack. + += Usage + +As an example, here's an effect which lifts to 'Program' @τ@, does some log +output, then unlifts back to 'Effectful.Internal.Monad.Eff' @es@ to then query +something from the 'Effectful.Environment.Environment' effect (which requires +the 'Effectful.Internal.Monad.IOE' effect to run): + +@ +retrieveProgramName + :: forall τ es + . ('Effectful.Internal.Monad.IOE' 'Effectful.Internal.Effect.:>' es, 'ProgramE' τ 'Effectful.Internal.Effect.:>' es) + => 'Effectful.Internal.Monad.Eff' es () +retrieveProgramName = do + -- we're in (IOE :> es, ProgramE :> es) => Eff es, right? + + 'withProgram' @τ $ \\runEffect -> do + -- now we're in Program τ + + 'Core.Program.Logging.info' \"Running in Program\" + + path <- runEffect $ do + -- now back in (IOE :> es, ProgramE τ :> es) => Eff es, and can call + -- something that requires the IOE effect be present. + + 'Effectful.Environment.runEnvironment' $ do + -- now in (Environment :> es) => Eff es + 'Effectful.Environment.getExecutablePath' + + 'Core.Program.Logging.info' \"Done running effects\" + 'Core.Program.Logging.debugS' "path" path +@ + +The @@τ@ type application shown here is vital; without it the compiler will +not be able to resolve all the ambiguous types when attempting to determine +which effect to run. It doesn't have to be polymorphic; if you know the actual +top-level application state type you can do @@Settings@ or whatever. + +This all assumes you are running with the 'ProgramE' @τ@ effect in-scope. You +can achieve that as follows: + +@ +main :: 'IO' () +main = 'Core.Program.Execute.execute' program + +program :: 'Program' 'None' () +program = do + -- in Program τ, where τ is None here + context <- 'Core.Program.Execute.getContext' + 'Control.Monad.IO.Class.liftIO' $ do + -- in IO + 'Effectful.Internal.Monad.runEff' $ do + -- in (IOE :> es) => Eff es + 'runProgramE' context $ do + -- in (IOE :> es, ProgramE τ :> es) => Eff es + ... +@ +-} +module Core.Effect.Effectful + ( -- * Effect + ProgramE + , runProgramE + + -- * Lifting and unlifting + , withProgram + , withProgram' + ) +where + +-- +-- We follow the convention used elsewhere in this collection of libraries of +-- using a qualified name for the imports of significant libraries. It's a bit +-- cumbersome, but makes it easier to disambiguate what's going on when +-- comparing to almost identical code in sibling modules covering other +-- webserver frameworks. +-- + +import Core.Program.Context +import Core.System.Base +import Data.Kind (Type) +import Effectful.Internal.Effect (type (:>)) +import Effectful.Internal.Effect qualified as Effect + ( Effect + ) +import Effectful.Internal.Env qualified as Effect + ( Dispatch (Static) + , DispatchOf + , SideEffects (WithSideEffects) + ) +import Effectful.Internal.Monad qualified as Effect + ( Eff + , IOE + , StaticRep + , evalStaticRep + , getStaticRep + , putStaticRep + , withEffToIO + ) + +------------------------------------------------------------------------------- +-- Effect + +{- | +An effect giving you access to return to the 'Program' @τ@ monad. +-} +data ProgramE (τ :: Type) :: Effect.Effect + +type instance Effect.DispatchOf (ProgramE τ) = 'Effect.Static 'Effect.WithSideEffects +newtype instance Effect.StaticRep (ProgramE τ) = ProgramE (Context τ) + +------------------------------------------------------------------------------- +-- Interpretation + +{- | +Given you are in the 'Effectful.Internal.Monad.IOE' effect, raise the +currently in-scope effects to include the 'ProgramE' effect. This will +presumably be invoked fairly soon after entering the effect system, and it +needs to have been done inside a program that was started with +'Core.Program.Execute.execute' or 'Core.Program.Execute.executeWith'. Assuming +that to be the case, get the 'Context' @τ@ object from the outside edge of +your program using 'getContext' and then provide it to this function at the +earliest opportunity. +-} +runProgramE + :: forall τ es α + . Effect.IOE :> es + => Context τ + -> Effect.Eff (ProgramE τ : es) α + -> Effect.Eff es α +runProgramE context = Effect.evalStaticRep (ProgramE context) + +-------------------------------------------------------------------------------- +-- Wrappers + +{- | +Simple variant of 'withProgram' which allows you to run a 'Program' @τ@ monad +action from within the effect system, provided that the 'ProgramE' @τ@ effect +is in scope. +-} +withProgram' + :: forall τ es α + . (Effect.IOE :> es, ProgramE τ :> es) + => Program τ α + -> Effect.Eff es α +withProgram' action = do + ProgramE context1 <- Effect.getStaticRep + + -- lift to IO + liftIO $ do + -- now in IO. Lift to Program τ + subProgram context1 $ do + action + +{- | +Run a 'Program' @τ@ monad action within the 'ProgramE' @τ@ effect. + +This allows you the ability to lift to the 'Program' @τ@ monad, giving you the +ability to run actions that do logging, telemetry, input/output, and exception +handling, and then unlift back to the 'Eff' @es@ effect to continue work in +the effects system. + +The order of the existential types in the @forall@ turned out to matter; it +allows you to use the @TypeApplications@ language extention to resolve the +ambiguous types when invoking this function. + +See also "Core.Program.Unlift" for a general discussion of the unlifting +problem and in particular the 'Core.Program.Unlift.withContext' for a function +with a comparable type signature. +-} +withProgram + :: forall τ es α + . (Effect.IOE :> es, ProgramE τ :> es) + => ((forall β. Effect.Eff es β -> Program τ β) -> Program τ α) + -> Effect.Eff es α +withProgram action = do + -- extract Context τ + ProgramE context1 <- Effect.getStaticRep + + -- lift to IO, using the provided specialized function which gives an unlift + -- function for later use. + Effect.withEffToIO $ \runInIO -> + -- now in IO. Lift to Program τ + subProgram context1 $ do + -- now in Program τ. We form the function that will run an effect + -- in Program τ, and pass it to the supplied action. + action $ \inner -> do + context2 <- getContext + liftIO $ do + -- now in IO + runInIO $ do + -- now in (IOE :> es, ProgramE :> es) => Eff es, but + -- we need to update the Context τ in the ProgramE τ + -- effect with the one that was present just before we + -- ran the unlifting function. + Effect.putStaticRep (ProgramE context2) + + -- now we can proceed with running the nested effects. + inner