Common.hs

{-# LANGUAGE TypeApplications #-}

module CLI.Commands.Common where

import CLI.Types
import Control.Lens                        (use)
import Control.Monad                       (when)
import Control.Monad.IO.Class              (liftIO)
import Control.Monad.Trans.Maybe           (MaybeT(..), runMaybeT)
import Control.Monad.State.Strict          (StateT, lift)
import Data.Bool                           (bool)
import Data.IP                             (IP)
import Data.List                           (find)
import Data.Text                           (Text, pack)
import Text.Read                           (readMaybe)
import StrongSwan.SQL                      (SQLRow)
import System.Console.StructuredCLI hiding (Commands)

import qualified StrongSwan.SQL as SQL

string :: (Monad m) => String -> m (Maybe Text)
string = return . Just . pack

integer :: (Monad m, Integral n ) => String -> m (Maybe n)
integer = return . fmap fromIntegral . readMaybe @Integer

ipAddress :: (Monad m) => String -> m (Maybe IP)
ipAddress = return . readMaybe

boolean :: (Monad m) => String -> String -> String -> m (Maybe Bool)
boolean yes no str | str == yes = return $ Just True
                   | str == no  = return $ Just False
                   | otherwise  = return Nothing

oneOf :: (Monad m) => [(String, a)] -> String -> m (Maybe a)
oneOf opts str = runMaybeT $ do
    (_, x) <- MaybeT . return $ find ((str == ) . fst) opts
    return x

exitCmd :: Commands ()
exitCmd = command "exit" "Go back one level" exit

showEnabled :: Bool -> String
showEnabled = bool "disabled" "enabled"

readEnabled :: (Monad m) => String -> m (Maybe Bool)
readEnabled = boolean "enabled" "disabled"

readBool :: (Monad m) => String -> m (Maybe Bool)
readBool = return . fromName

flushIt :: StateT AppState IO Action
flushIt = do
  result <- runMaybeT $ do
   f <- MaybeT $ use flush
   lift f
  maybe (return NoAction) return result

setConfig :: (SQLRow a, Eq a, Show k)
    => (k -> SQL.Context -> IO [a]) -> a -> k -> StateT AppState IO a
setConfig getFn def' key = do
  db <- use dbContext
  result <- liftIO $ getFn key db
  case result of
    []   ->
      return def'
    x:xs -> do
      when (xs /= []) $
        liftIO . putStrLn $ "Warning: multiple config named " ++ show key ++ " found"
      return x