little-rio (empty) → 0.1.0

raw patch · 5 files changed

+227/−0 lines, 5 filesdep +basedep +exceptionsdep +microlenssetup-changed

Dependencies added: base, exceptions, microlens, microlens-mtl, mtl, unliftio-core

Files

LICENSE +30/−0
README.md +7/−0
Setup.hs +2/−0
little-rio.cabal +44/−0
src/LittleRIO.hs +144/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (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.

+ README.md view

@@ -0,0 +1,7 @@+# little-rio++[![CircleCI](https://circleci.com/gh/ejconlon/little-rio/tree/master.svg?style=svg)](https://circleci.com/gh/ejconlon/little-rio/tree/master)++When you need just the `RIO` monad (but you want a `MonadCatch` instance)++This is derived from the RIO library ([LICENSE](https://hackage.haskell.org/package/rio-0.1.14.0/src/LICENSE)).

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ little-rio.cabal view

@@ -0,0 +1,44 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2b2090b27367642626349e26b93496440dae5c6ca1e56579cbbdee0ea5b68200++name:           little-rio+version:        0.1.0+synopsis:       When you need just the RIO monad+description:    Please see the README on GitHub at <https://github.com/ejconlon/little-rio#readme>+category:       Control+homepage:       https://github.com/ejconlon/little-rio#readme+bug-reports:    https://github.com/ejconlon/little-rio/issues+author:         Eric Conlon+maintainer:     ejconlon@gmail.com+copyright:      (c) 2020 Eric Conlon+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/ejconlon/little-rio++library+  exposed-modules:+      LittleRIO+  other-modules:+      Paths_little_rio+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds+  build-depends:+      base >=4.12 && <5+    , exceptions >=0.10+    , microlens >=0.4+    , microlens-mtl >=0.2+    , mtl >=2.2+    , unliftio-core >=0.1+  default-language: Haskell2010

+ src/LittleRIO.hs view

@@ -0,0 +1,144 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+Most definitions follow the RIO lib: https://hackage.haskell.org/package/rio-0.1.14.0/docs/RIO.html+See LICENSE info in the README.+-}+module LittleRIO+  ( HasStateRef (..)+  , HasWriteRef (..)+  , SomeRef+  , RIO (..)+  , getStateRef+  , liftRIO+  , listenWriteRef+  , newSomeRef+  , mapRIO+  , modifySomeRef+  , modifyStateRef+  , passWriteRef+  , putStateRef+  , runRIO+  , readSomeRef+  , tellWriteRef+  , unliftRIO+  , writeSomeRef+  ) where++import Control.Applicative (liftA2)+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO, askUnliftIO)+import Control.Monad.Reader (MonadReader (..), ReaderT (..))+import Control.Monad.State (MonadState (..))+import Control.Monad.Writer (MonadWriter (..))+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Lens.Micro (Lens')+import Lens.Micro.Mtl (view)+import Prelude++newtype RIO env a = RIO { unRIO :: ReaderT env IO a }+  deriving (Functor, Applicative, Monad, MonadReader env, MonadIO, MonadThrow, MonadFail, MonadCatch, MonadMask, MonadUnliftIO)++instance Semigroup a => Semigroup (RIO env a) where+  (<>) = liftA2 (<>)++instance Monoid a => Monoid (RIO env a) where+  mempty = pure mempty+  mappend = (<>)++mapRIO :: (env -> env') -> RIO env' a -> RIO env a+mapRIO f m = do+  env <- ask+  let env' = f env+  runRIO env' m++liftRIO :: (MonadIO m, MonadReader env m) => RIO env a -> m a+liftRIO rio = do+  env <- ask+  runRIO env rio++unliftRIO :: MonadIO m => env -> m (UnliftIO (RIO env))+unliftRIO env = liftIO (runRIO env askUnliftIO)++runRIO :: MonadIO m => env -> RIO env a -> m a+runRIO r m = liftIO (runReaderT (unRIO m) r)++data SomeRef a = SomeRef !(IO a) !(a -> IO ())++readSomeRef :: MonadIO m => SomeRef a -> m a+readSomeRef (SomeRef x _) = liftIO x++writeSomeRef :: MonadIO m => SomeRef a -> a -> m ()+writeSomeRef (SomeRef _ x) = liftIO . x++modifySomeRef :: MonadIO m => SomeRef a -> (a -> a) -> m ()+modifySomeRef (SomeRef read' write) f = liftIO (fmap f read' >>= write)++ioRefToSomeRef :: IORef a -> SomeRef a+ioRefToSomeRef ref = SomeRef (readIORef ref) (writeIORef ref)++newSomeRef :: MonadIO m => a -> m (SomeRef a)+newSomeRef = liftIO . fmap ioRefToSomeRef . newIORef++class HasStateRef st env | env -> st where+  stateRefL :: Lens' env (SomeRef st)++instance HasStateRef a (SomeRef a) where+  stateRefL = id++getStateRef :: (HasStateRef st env, MonadReader env m, MonadIO m) => m st+getStateRef = do+  ref <- view stateRefL+  liftIO (readSomeRef ref)++putStateRef :: (HasStateRef st env, MonadReader env m, MonadIO m) => st -> m ()+putStateRef st = do+  ref <- view stateRefL+  liftIO (writeSomeRef ref st)++modifyStateRef :: (HasStateRef st env, MonadReader env m, MonadIO m) => (st -> st) -> m ()+modifyStateRef f = do+  ref <- view stateRefL+  liftIO (modifySomeRef ref f)++instance HasStateRef st env => MonadState st (RIO env) where+  get = getStateRef+  put = putStateRef++class HasWriteRef w env | env -> w where+  writeRefL :: Lens' env (SomeRef w)++instance HasWriteRef a (SomeRef a) where+  writeRefL = id++tellWriteRef :: (HasWriteRef w env, MonadReader env m, MonadIO m, Semigroup w) => w -> m ()+tellWriteRef value = do+  ref <- view writeRefL+  liftIO $ modifySomeRef ref (<> value)++listenWriteRef :: (HasWriteRef w env, MonadReader env m, MonadIO m) => m a -> m (a, w)+listenWriteRef action = do+  w1 <- view writeRefL >>= liftIO . readSomeRef+  a <- action+  w2 <- do+    refEnv <- view writeRefL+    v <- liftIO $ readSomeRef refEnv+    _ <- liftIO $ writeSomeRef refEnv w1+    return v+  return (a, w2)++passWriteRef :: (HasWriteRef w env, MonadReader env m, MonadIO m) => m (a, w -> w) -> m a+passWriteRef action = do+  (a, transF) <- action+  ref <- view writeRefL+  liftIO $ modifySomeRef ref transF+  return a++instance (Monoid w, HasWriteRef w env) => MonadWriter w (RIO env) where+  tell = tellWriteRef+  listen = listenWriteRef+  pass = passWriteRef