module Clckwrks.CLI.ProfileData where import Control.Applicative ((<$>), (<*>), (*>), pure) import Clckwrks (UserId(..)) import Clckwrks.CLI.Core (CLIHandler(..)) import Clckwrks.ProfileData.Acid (ProfileDataState(..), GetProfileData(..), AddRole(..), RemoveRole(..)) import Clckwrks.ProfileData.Types (Role(..)) import Control.Monad.Reader import Data.Acid (AcidState) import Data.Acid.Advanced (query', update') import Data.Acid.Remote (openRemoteState, skipAuthenticationPerform) import Network (PortID(UnixSocket)) import System.Environment import System.FilePath (()) import System.Console.Haskeline import Text.Parsec import Text.Parsec.String -- right now this just connects to the server and makes UserId 1 an administrator -- -- eventually there should be an actually useful command-line interface {- main :: IO () main = do [socket] <- getArgs acid <- openRemoteState "localhost" (UnixSocket socket) update acid (AddRole (UserId 1) Administrator) pd <- query acid (GetProfileData (UserId 1)) print pd -} {- main :: IO () main = do args <- getArgs case args of [socket] -> do acid <- openRemoteState skipAuthenticationPerform "localhost" (UnixSocket socket) putStrLn "type 'help' for a list of commands." runReaderT (runInputT defaultSettings loop) acid _ -> putStrLn "Usage: clckwrks-cli path/to/profileData_socket" -} data UserCmd = UCShow UserId | UCAddRole UserId Role | UCRemoveRole UserId Role deriving (Eq, Ord, Read, Show) showUserHelp :: [String] showUserHelp = [ "user list - show all users" , "user show - show profile data for " , "user add-role - add a role (such as Administrator)" , "user remove-role - remove a role" ] pRole :: Parser Role pRole = string "Administrator" *> pure Administrator pUserId :: Parser UserId pUserId = UserId <$> (read <$> many1 digit) pUserCmd :: Parser UserCmd pUserCmd = {- do string "list" return UCList <|> -} do string "show" skipMany1 space u <- pUserId return (UCShow u) <|> do string "add-role" skipMany1 space u <- pUserId skipMany1 space r <- pRole return (UCAddRole u r) <|> do string "remove-role" skipMany1 space u <- pUserId skipMany1 space r <- pRole return (UCRemoveRole u r) execUserCommand :: UserCmd -> ReaderT (AcidState ProfileDataState) IO () {- execUserCommand UCList = do a <- ask all <- query' a GetUserIdUsernames lift $ print all return () -} execUserCommand (UCShow uid) = do a <- ask pd <- query' a (GetProfileData uid) lift $ print pd execUserCommand (UCAddRole uid role) = do a <- ask update' a (AddRole uid role) execUserCommand (UCRemoveRole uid role) = do a <- ask update' a (RemoveRole uid role) initUserCommand :: FilePath -> IO (UserCmd -> IO ()) initUserCommand basePath = do profileData <- openRemoteState skipAuthenticationPerform "localhost" (UnixSocket ((basePath "profileData_socket"))) pure $ \c -> runReaderT (execUserCommand c) profileData userCLIHandler :: FilePath -> IO CLIHandler userCLIHandler basePath = do exec <- initUserCommand basePath pure $ CLIHandler { cliPrefix = "user" , cliExec = exec , cliParser = pUserCmd , cliHelp = showUserHelp }