diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013 Gabriel Gonzalez, 2018 Metrix.AI +Copyright (c) 2013 Gabriel Gonzalez, 2018 Metrix.AI, 2020 Nikita Volkov Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/acquire.cabal b/acquire.cabal --- a/acquire.cabal +++ b/acquire.cabal @@ -1,50 +1,72 @@ -name: - acquire -version: - 0.2.0.1 -synopsis: - Abstraction over management of resources +cabal-version: 3.0 +name: acquire +version: 0.3.6 +synopsis: Abstraction over management of resources description: An implementation of the abstraction suggested in . -category: - Resources -homepage: - https://github.com/metrix-ai/acquire -bug-reports: - https://github.com/metrix-ai/acquire/issues -author: - Nikita Volkov -maintainer: - Metrix.AI Ninjas + +category: Resources +homepage: https://github.com/metrix-ai/acquire +bug-reports: https://github.com/metrix-ai/acquire/issues +author: Nikita Volkov +maintainer: Nikita Volkov copyright: - (c) 2013 Gabriel Gonzalez, 2018 Metrix.AI -license: - MIT -license-file: - LICENSE -build-type: - Simple -cabal-version: - >=1.10 + (c) 2013 Gabriel Gonzalez, 2018 Metrix.AI, 2020 Nikita Volkov +license: MIT +license-file: LICENSE +build-type: Simple + source-repository head - type: - git - location: - git://github.com/metrix-ai/acquire.git + type: git + location: git://github.com/metrix-ai/acquire.git library - hs-source-dirs: - library + hs-source-dirs: library default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 - exposed-modules: - Acquire.Acquire - Acquire.IO - other-modules: - Acquire.Prelude + NoImplicitPrelude + NoMonomorphismRestriction + Arrows + BangPatterns + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + EmptyDataDecls + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + InstanceSigs + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeFamilies + TypeOperators + UnboxedTuples + + default-language: Haskell2010 + exposed-modules: Acquire + other-modules: Acquire.Prelude build-depends: - base >=4.7 && <5 + , base >=4.9 && <5 + , mtl >=2.3 && <3 + , transformers >=0.5 && <0.8 diff --git a/library/Acquire.hs b/library/Acquire.hs new file mode 100644 --- /dev/null +++ b/library/Acquire.hs @@ -0,0 +1,101 @@ +module Acquire where + +import Acquire.Prelude + +-- * IO + +-- | +-- Acquire resources and use them by lifting IO into acquire. +acquire :: Acquire.Acquire a -> IO a +acquire (Acquire.Acquire setup) = + bracket setup snd (pure . fst) + +-- | +-- Execute an action, which uses a resource, +-- having a resource provider. +acquireAndUse :: Acquire env -> Use env err res -> IO (Either err res) +acquireAndUse (Acquire acquireIo) (Use useRdr) = + bracket acquireIo snd (runExceptT . runReaderT useRdr . fst) + +-- | +-- Run use on an acquired environment. +useAcquired :: env -> Use env err res -> IO (Either err res) +useAcquired env (Use (ReaderT run)) = + run env & runExceptT + +-- * Acquire + +-- | +-- Resource provider. +-- Abstracts over resource acquisition and releasing. +-- +-- Composes well, allowing you to merge multiple providers into one. +-- +-- Implementation of http://www.haskellforall.com/2013/06/the-resource-applicative.html +newtype Acquire env + = Acquire (IO (env, IO ())) + +instance Functor Acquire where + fmap f (Acquire io) = + Acquire $ do + (env, release) <- io + return (f env, release) + +instance Applicative Acquire where + pure env = + Acquire (pure (env, pure ())) + Acquire io1 <*> Acquire io2 = + Acquire $ do + (f, release1) <- io1 + (x, release2) <- onException io2 release1 + return (f x, release2 >> release1) + +instance Monad Acquire where + return = pure + (>>=) (Acquire io1) k2 = + Acquire $ do + (resource1, release1) <- io1 + (resource2, release2) <- case k2 resource1 of Acquire io2 -> onException io2 release1 + return (resource2, release2 >> release1) + +instance MonadIO Acquire where + liftIO io = + Acquire (fmap (,return ()) io) + +-- | Construct 'Acquire' by specifying a resource initializer and finalizer actions. +startAndStop :: + -- | Start the service. + IO a -> + -- | Stop the service. + (a -> IO ()) -> + Acquire a +startAndStop start stop = + Acquire $ do + logger <- start + pure (logger, stop logger) + +-- * Use + +-- | +-- Resource handler, which has a notion of pure errors. +newtype Use env err res = Use (ReaderT env (ExceptT err IO) res) + deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadIO, MonadError err, MonadReader env) + +instance Bifunctor (Use env) where + first = mapErr + second = fmap + +-- | +-- Map the environment of a resource handler. +mapEnv :: (b -> a) -> Use a err res -> Use b err res +mapEnv fn (Use rdr) = Use (withReaderT fn rdr) + +-- | +-- Map the error of a resource handler. +mapErr :: (a -> b) -> Use env a res -> Use env b res +mapErr fn (Use rdr) = Use (mapReaderT (withExceptT fn) rdr) + +-- | +-- Map both the environment and the error of a resource handler. +mapEnvAndErr :: (envB -> envA) -> (errA -> errB) -> Use envA errA res -> Use envB errB res +mapEnvAndErr envProj errProj (Use rdr) = Use (withReaderT envProj (mapReaderT (withExceptT errProj) rdr)) diff --git a/library/Acquire/Acquire.hs b/library/Acquire/Acquire.hs deleted file mode 100644 --- a/library/Acquire/Acquire.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Acquire.Acquire -where - -import Acquire.Prelude - - -{-| -Implementation of http://www.haskellforall.com/2013/06/the-resource-applicative.html --} -newtype Acquire resource = - Acquire (IO (resource, IO ())) - -instance Functor Acquire where - fmap f (Acquire io) = - Acquire $ do - (resource, release) <- io - return (f resource, release) - -instance Applicative Acquire where - pure resource = - Acquire (pure (resource, pure ())) - Acquire io1 <*> Acquire io2 = - Acquire $ do - (f, release1) <- io1 - (x, release2) <- onException io2 release1 - return (f x, release2 >> release1) - -instance Monad Acquire where - return = pure - (>>=) (Acquire io1) k2 = - Acquire $ do - (resource1, release1) <- io1 - (resource2, release2) <- case k2 resource1 of Acquire io2 -> onException io2 release1 - return (resource2, release2 >> release1) - -instance MonadIO Acquire where - liftIO io = - Acquire (fmap (, return ()) io) diff --git a/library/Acquire/IO.hs b/library/Acquire/IO.hs deleted file mode 100644 --- a/library/Acquire/IO.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Acquire.IO -where - -import Acquire.Prelude -import Acquire.Acquire - - -acquire :: Acquire resource -> (resource -> IO a) -> IO a -acquire (Acquire io) handle = - bracket io snd (handle . fst) - diff --git a/library/Acquire/Prelude.hs b/library/Acquire/Prelude.hs --- a/library/Acquire/Prelude.hs +++ b/library/Acquire/Prelude.hs @@ -1,20 +1,27 @@ module Acquire.Prelude -( - module Exports, -) + ( module Exports, + ) where --- base -------------------------- import Control.Applicative as Exports -import Control.Arrow as Exports +import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (forM, forM_, mapM, mapM_, msum, sequence, sequence_) +import Control.Monad.Error.Class as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports +import Control.Monad.Reader.Class as Exports import Control.Monad.ST as Exports +import Control.Monad.Trans.Class as Exports +import Control.Monad.Trans.Cont as Exports hiding (callCC, shift) +import Control.Monad.Trans.Except as Exports (Except, ExceptT (ExceptT), except, mapExcept, mapExceptT, runExcept, runExceptT, withExcept, withExceptT) +import Control.Monad.Trans.Maybe as Exports (MaybeT (MaybeT), exceptToMaybeT, mapMaybeT, maybeToExceptT) +import Control.Monad.Trans.Reader as Exports (Reader, ReaderT (ReaderT), mapReader, mapReaderT, runReader, runReaderT, withReader, withReaderT) +import Control.Monad.Trans.State.Strict as Exports (State, StateT (StateT), evalState, evalStateT, execState, execStateT, mapState, mapStateT, runState, runStateT, withState, withStateT) +import Control.Monad.Trans.Writer.Strict as Exports (Writer, WriterT (WriterT), execWriter, execWriterT, mapWriter, mapWriterT, runWriter) +import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports import Data.Char as Exports @@ -26,11 +33,11 @@ import Data.Fixed as Exports import Data.Foldable as Exports import Data.Function as Exports hiding (id, (.)) -import Data.Functor as Exports -import Data.Int as Exports +import Data.Functor as Exports hiding (unzip) import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) import Data.Maybe as Exports import Data.Monoid as Exports import Data.Ord as Exports @@ -48,12 +55,11 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports -import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (lazy, inline, sortWith, groupWith) +import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports -import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) @@ -62,8 +68,7 @@ import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports -import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) -import Text.Read as Exports (Read(..), readMaybe, readEither) +import Text.Printf as Exports (hPrintf, printf) +import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports +import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))