ProfileData.hs

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 <userid>                 - show profile data for <userid>"
    , "user add-role <userid> <role>      - add a role (such as Administrator)"
    , "user remove-role <userid> <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
       }