rio-app-0.1.0.0: example/Main.hs

{-# 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