rio-app (empty) → 0.1.0.0

raw patch · 7 files changed

+297/−0 lines, 7 filesdep +basedep +optparse-simpledep +resourcetsetup-changed

Dependencies added: base, optparse-simple, resourcet, rio, rio-app

Files

• ChangeLog.md +7/−0
• LICENSE +30/−0
• README.md +3/−0
• Setup.hs +2/−0
• example/Main.hs +103/−0
• rio-app.cabal +52/−0
• src/RIO/App.hs +100/−0

@@ -0,0 +1,7 @@+# Changelog for rio-app++## [0.1.0.0]+++ Initial import++[0.1.0.0]: https://gitlab.com/dpwiz/rio-app/tree/v0.1.0.0

@@ -0,0 +1,30 @@+Copyright Alexander Bondarenko (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 Alexander Bondarenko 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,3 @@+# Batteries-included RIO environment++Check out `example/Main.hs`.

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

@@ -0,0 +1,103 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import RIO+import Data.Char (chr, ord)+import RIO.State (modify)+import Control.Monad.Trans.Resource (register, release)++import Data.Acquire+import RIO.App+import Options.Applicative.Simple (simpleVersion, simpleOptions)+import qualified Options.Applicative.Simple as Opt++import qualified Paths_rio_app++main :: IO ()+main = appMain parseOptions optionsVerbose setup run++setup :: Options -> RIO SetupApp (Char, Int)+setup opts = do+  -- XXX: Setup has logging, but no special env and state+  logDebug $ displayShow opts+  () <- asks appEnv+  modify $ \() -> ()++  {- XXX:+    Setup has resources that are acquired for the application lifetime+    and released in reverse order.+  -}+  (_releaseKey, res) <- allocateAcquire $ scarceResource 0+  register $+    hPutBuilder stderr "Bye!\n"++  pure (res, 0)++-- TODO: lift acquire procedures to allow logging etc.+scarceResource :: Int -> Acquire Char+scarceResource n =+  mkAcquire create destroy+  where+    create = do+      let r = chr (ord 'R' + n)+      hPutBuilder stderr . getUtf8Builder $+        "Resource created: " <> displayShow r <> "\n"+      pure r++    destroy res =+      hPutBuilder stderr . getUtf8Builder $+        "Destroying resource: " <> displayShow res <> "\n"++run :: RIO (App Char Int) ()+run = do+  modify (+ 1)+  logInfo "We're inside the application!"+  nestApp+    ((,) <$> asks appEnv <*> pure ())+    runInner++runInner :: RIO (App Char st) ()+runInner = do+  (releaseKey, res) <- allocateAcquire $ scarceResource 2+  logInfo "We're inside even more!"+  release releaseKey+  logInfo $ "  Our resource was: " <> displayShow res++-- | Command line arguments+data Options = Options+  { optionsVerbose :: Bool+  }+  deriving (Show)++parseOptions :: IO Options+parseOptions = do+  (options, ()) <- simpleOptions+    $(simpleVersion Paths_rio_app.version)+    header+    description+    optionsP+    commandP+  pure options+  where+    header =+      "Header for command line arguments"++    description =+      "Program description, also for command line arguments"++    optionsP = do+      optionsVerbose <- Opt.switch $ mconcat+        [ Opt.long "verbose"+        , Opt.short 'v'+        , Opt.help "Show more and more detailed messages"+        ]++      pure Options{..}++    commandP =+      Opt.empty

@@ -0,0 +1,52 @@+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: dc1e33e8963ff3b4c4fbfbc764560ecdaa86de06303e1a41b08a7efac425a9de++name:           rio-app+version:        0.1.0.0+synopsis:       Generic App type for rio.+category:       Control+author:         Alexander Bondarenko+maintainer:     aenor.realm@gmail.com+copyright:      Alexander Bondarenko+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/dpwiz/rio-app++library+  exposed-modules:+      RIO.App+  other-modules:+      Paths_rio_app+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , resourcet+    , rio+  default-language: Haskell2010++executable rio-app-example+  main-is: Main.hs+  other-modules:+      Paths_rio_app+  hs-source-dirs:+      example+  build-depends:+      base >=4.7 && <5+    , optparse-simple+    , resourcet+    , rio+    , rio-app+  default-language: Haskell2010

@@ -0,0 +1,100 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module RIO.App+  ( App(..)+  , SetupApp+  , appMain+  , nestApp+  ) where++import RIO++import Control.Monad.Trans.Resource (MonadResource(..))+import qualified Control.Monad.Trans.Resource as ResourceT+import RIO.Process (HasProcessContext(..), ProcessContext, mkDefaultProcessContext)++data App env st = App+  { appLogFunc        :: LogFunc+  , appProcessContext :: ProcessContext+  , appResources      :: ResourceT.InternalState+  , appEnv            :: env+  , appState          :: SomeRef st+  }++instance HasLogFunc (App env st) where+  logFuncL =+    lens+      appLogFunc+      \x y -> x{appLogFunc = y}++instance HasProcessContext (App env st) where+  processContextL =+    lens+      appProcessContext+      \x y -> x{appProcessContext = y}++instance MonadResource (RIO (App env st)) where+  liftResourceT action =+    asks appResources >>=+      liftIO . ResourceT.runInternalState action++instance HasStateRef st (App env st) where+  stateRefL =+    lens+      appState+      \x y -> x{appState = y}++{- | Bootstrap environment.++Has logging and hold permanent resources, but no env and state of its own.+Used to setup initial environment and state, that can be derived from allocated resources.+-}+type SetupApp = App () ()++appMain+  :: IO options+  -> (options -> Bool)+  -> (options -> RIO SetupApp (env, st))+  -> RIO (App env st) ()+  -> IO ()+appMain parseOptions verbose setup run = do+  options <- parseOptions++  logFunc <- logOptionsHandle stderr (verbose options)+  appProcessContext <- mkDefaultProcessContext+  stateRef <- newSomeRef ()++  withLogFunc logFunc \appLogFunc ->+    bracket ResourceT.createInternalState ResourceT.closeInternalState \appResources -> do+      let+        setupApp = App+          { appEnv   = ()+          , appState = stateRef+          , ..+          }+      runRIO setupApp $+        nestApp (setup options) run++nestApp+  :: (MonadUnliftIO m, MonadReader (App env st) m)+  => RIO (App env st) (innerEnv, innerSt)+  -> RIO (App innerEnv innerSt) a+  -> m a+nestApp setupNext action =+  bracket ResourceT.createInternalState ResourceT.closeInternalState \nestedResources -> do+    oldApp <- ask+    (innerEnv, innerState) <- runRIO+      oldApp{appResources=nestedResources}+      setupNext+    innerStateRef <- newSomeRef innerState+    let+      nextApp = oldApp+        { appResources = nestedResources+        , appEnv       = innerEnv+        , appState     = innerStateRef+        }+    runRIO nextApp action