clckwrks-cli (empty) → 0.2.0
raw patch · 4 files changed
+200/−0 lines, 4 filesdep +acid-statedep +basedep +clckwrksbuild-type:Customsetup-changed
Dependencies added: acid-state, base, clckwrks, haskeline, mtl, network, parsec
Files
- LICENSE +30/−0
- Main.hs +142/−0
- Setup.hs +2/−0
- clckwrks-cli.cabal +26/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Jeremy Shaw++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jeremy Shaw nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,142 @@+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)+import Network (PortID(UnixSocket))+import System.Environment+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 "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+ mpd <- query' a (GetProfileData uid)+ case mpd of+ Nothing -> lift $ putStrLn $ "Invalid userid."+ (Just pd) -> 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 ()+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ clckwrks-cli.cabal view
@@ -0,0 +1,26 @@+Name: clckwrks-cli+Version: 0.2.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/+License: BSD3+License-file: LICENSE+Author: Jeremy Shaw+Maintainer: jeremy@n-heptane.com+Copyright: 2012 Jeremy Shaw, SeeReason Partners LLC+Category: Clckwrks+Build-type: Custom+Cabal-version: >=1.6++Executable clckwrks-cli+ Main-is:+ Main.hs++ Build-depends:+ acid-state >= 0.7 && < 0.9,+ base < 5,+ clckwrks >= 0.12 && < 0.14,+ haskeline == 0.7.*,+ mtl >= 2.0 && < 2.2,+ network >= 2.3 && < 2.5,+ parsec == 3.1.*