clckwrks-cli 0.2.17.3 → 0.3.0
raw patch · 4 files changed
+233/−138 lines, 4 filesdep +clckwrks-clidep +containersdep +filepathdep ~clckwrksdep ~network
Dependencies added: clckwrks-cli, containers, filepath
Dependency ranges changed: clckwrks, network
Files
- Clckwrks/CLI/Core.hs +79/−0
- Clckwrks/CLI/ProfileData.hs +122/−0
- Main.hs +11/−135
- clckwrks-cli.cabal +21/−3
+ Clckwrks/CLI/Core.hs view
@@ -0,0 +1,79 @@+{-# language ExistentialQuantification #-}+module Clckwrks.CLI.Core where++import Control.Applicative ((<$>), (<*>), (*>), pure)+import Control.Monad (forever)+import Control.Monad.Reader (runReaderT)+import Control.Monad.Trans (liftIO)+import Data.Acid (AcidState)+import Data.Acid.Advanced (query', update')+import Data.Acid.Remote (openRemoteState, skipAuthenticationPerform)+import Data.Map (Map)+import qualified Data.Map as Map+import Network (PortID(UnixSocket))+import System.Environment+import System.Exit (exitSuccess)+import System.Console.Haskeline+import Text.Parsec+import Text.Parsec.String++data CLIHandler = forall cmd. CLIHandler+ { cliPrefix :: String+ , cliExec :: cmd -> IO ()+ , cliParser :: Parser cmd+ , cliHelp :: [String]+ }++data Command+ = Quit+ | Help+ deriving (Eq, Ord, Read, Show)++pCommand :: Parser Command+pCommand =+ do string "quit" *> return Quit+ <|>+ do string "help" *> return Help++{-+ do string "user"+ skipMany1 space+ User <$> pUserCmd+ <|>+-}+++loop :: [CLIHandler] -> IO () -- InputT IO ()+loop handlers' =+ let handlers = Map.fromList (map (\h -> (cliPrefix h, h)) handlers') in+ runInputT defaultSettings $ forever $+ do minput <- getInputLine "% "+ case minput of+ Nothing -> return ()+ Just input ->+ let (prefix, rest') = span (/= ' ') $ dropWhile (== ' ') $ input+ rest = dropWhile (== ' ') $ rest'+ in case prefix of+ "help" -> liftIO $ execCommand (concatMap (cliHelp . snd) (Map.toAscList handlers)) Help+ "quit" -> liftIO $ exitSuccess+ _ -> case Map.lookup prefix handlers of+ Nothing -> liftIO $ putStrLn $ "unknow command prefix: " ++ prefix+ (Just (CLIHandler _ exec parser _)) ->+ do let r = parse parser input rest+ case r of+ (Left e) ->+ do liftIO $ print e+ (Right cmd) ->+ do liftIO $ exec cmd++execCommand :: [String] -> Command -> IO ()+execCommand helps Help =+ do putStrLn $ unlines $ (helps ++ showHelp)+ return ()++showHelp :: [String]+showHelp =+ [ "quit - quit"+ , "help - show this help"+ ]+
+ Clckwrks/CLI/ProfileData.hs view
@@ -0,0 +1,122 @@+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+ }
Main.hs view
@@ -1,140 +1,16 @@ module Main where -import Control.Applicative ((<$>), (<*>), (*>), pure)-import Clckwrks (UserId(..))-import Clckwrks.ProfileData.Acid (ProfileDataState(..), GetProfileData(..), AddRole(..), RemoveRole(..), GetUserIdUsernames(..))-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.Console.Haskeline-import Text.Parsec-import Text.Parsec.String+import Clckwrks.CLI.Core+import Clckwrks.CLI.ProfileData+import System.FilePath ((</>))+import System.Environment (getArgs) --- 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- = UCList- | UCShow UserId- | UCAddRole UserId Role- | UCRemoveRole UserId Role- deriving (Eq, Ord, Read, Show)--data Command- = User UserCmd- | Quit- | Help- deriving (Eq, Ord, Read, Show)--showHelp :: String-showHelp = unlines- [ "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"- , "quit - quit"- , "help - show this help"- ]--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)---pCommand :: Parser Command-pCommand =- do string "user"- skipMany1 space- User <$> pUserCmd- <|>- do string "quit" *> return Quit- <|>- do string "help" *> return Help--loop :: InputT (ReaderT (AcidState ProfileDataState) IO) ()-loop = do- minput <- getInputLine "% "- case minput of- Nothing -> return ()- Just input ->- do let r = parse pCommand input input- case r of- (Left e) ->- do liftIO $ print e- loop- (Right Quit) ->- return ()- (Right cmd) ->- do lift $ execCommand cmd- loop--execCommand :: Command -> ReaderT (AcidState ProfileDataState) IO ()-execCommand (User UCList) =- do a <- ask- all <- query' a GetUserIdUsernames- lift $ print all- return ()-execCommand (User (UCShow uid)) =- do a <- ask- pd <- query' a (GetProfileData uid)- lift $ print pd-execCommand (User (UCAddRole uid role)) =- do a <- ask- update' a (AddRole uid role)-execCommand (User (UCRemoveRole uid role)) =- do a <- ask- update' a (RemoveRole uid role)-execCommand Help =- do lift $ putStrLn $ showHelp- return ()-+ do args <- getArgs+ case args of+ [basePath] ->+ do u <- userCLIHandler basePath+ loop [u]+ putStrLn "type 'help' for a list of commands."+ _ -> putStrLn "Usage: clckwrks-cli path/to/_state"
clckwrks-cli.cabal view
@@ -1,5 +1,5 @@ Name: clckwrks-cli-Version: 0.2.17.3+Version: 0.3.0 Synopsis: a command-line interface for adminstrating some aspects of clckwrks Description: This tool permits browsing of users, changing their roles, and other features. Homepage: http://www.clckwrks.com/@@ -17,6 +17,21 @@ type: git location: git://github.com/clckwrks/clckwrks-cli.git +Library+ default-language: Haskell2010+ Exposed-Modules: Clckwrks.CLI.Core+ Clckwrks.CLI.ProfileData+ Build-depends:+ acid-state >= 0.12 && < 0.16,+ base < 5,+ clckwrks >= 0.23 && < 0.26,+ containers >= 0.6 && < 0.7,+ haskeline == 0.7.*,+ filepath >= 1.4 && < 1.5,+ mtl >= 2.0 && < 2.3,+ network >= 2.3 && < 3.2,+ parsec == 3.1.*+ Executable clckwrks-cli Main-is: Main.hs@@ -24,8 +39,11 @@ Build-depends: acid-state >= 0.12 && < 0.16, base < 5,- clckwrks >= 0.23 && < 0.25,+ clckwrks >= 0.23 && < 0.26,+ clckwrks-cli >= 0.3 && < 0.4,+ containers >= 0.6 && < 0.7, haskeline == 0.7.*,+ filepath >= 1.4 && < 1.5, mtl >= 2.0 && < 2.3,- network >= 2.3 && < 2.9,+ network >= 2.3 && < 3.2, parsec == 3.1.*