Permalink
Browse files

Re-do the config to handle global argument parsing, specifically for …

…--profile.
  • Loading branch information...
1 parent 61501ca commit fe7366fa503d5869841563b38dec0afab3f9ba5e @mike-burns committed Dec 25, 2011
Showing with 60 additions and 44 deletions.
  1. +17 −18 FindStory.hs
  2. +6 −24 InitTj.hs
  3. +37 −2 Trajectory/Private.hs
View
@@ -2,6 +2,8 @@
module Main where
+import System.Environment (getArgs)
+
import Data.List (intercalate)
import Data.Maybe (fromMaybe, fromJust)
@@ -18,13 +20,12 @@ import Data.Attoparsec
import Control.Applicative
import Data.Data
-import qualified Data.Text
-import qualified Data.Map
-
import Trajectory.Private
main = do
- potentiallyAllStories <- getAllStories :: IO (Either Error Stories)
+ args <- getArgs
+ (config, specificArgs) <- getConfig args
+ potentiallyAllStories <- (getAllStories config) :: IO (Either Error Stories)
case potentiallyAllStories of
(Left error) -> print error
(Right allStories) ->
@@ -47,10 +48,8 @@ formatStory story =
]
-allStoriesUrl = do
- config <- getConfig
- let (String keyText) = fromJust $ Data.Map.lookup (Data.Text.pack "default") config
- key = Data.Text.unpack keyText
+allStoriesUrl config = do
+ let key = getConfigKey config
return $ "https://www.apptrajectory.com/api/" ++ key ++ "/accounts/923bc9b85eaa4a9213c5/projects/activeblueleaf/stories.json"
@@ -121,9 +120,9 @@ instance FromJSON Stories where
Stories <$> o .: "stories"
parseJSON _ = fail "Could not build Stories"
-getAllStories :: (FromJSON b, Show b) => IO (Either Error b)
-getAllStories = do
- url <- allStoriesUrl
+getAllStories :: (FromJSON b, Show b) => Config -> IO (Either Error b)
+getAllStories config = do
+ url <- allStoriesUrl config
let method = BS.pack "GET"
body = Nothing :: Maybe String
(Just uri) = parseURI url
@@ -149,10 +148,10 @@ getAllStories = do
parseJson :: (FromJSON b, Show b) => BS.ByteString -> Either Error b
parseJson jsonString =
- let parsed = parse (fromJSON <$> json) jsonString in
- case parsed of
- Data.Attoparsec.Done _ jsonResult -> do
- case jsonResult of
- (Success s) -> Right s
- (Error e) -> Left $ JsonError $ e ++ " on the JSON: " ++ BS.unpack jsonString
- (Fail _ _ e) -> Left $ ParseError e
+ handle $ parse (fromJSON <$> json) jsonString
+ where
+ handle (Data.Attoparsec.Done _ (Success s)) = Right s
+ handle (Data.Attoparsec.Done _ (Error e)) =
+ Left $ JsonError $ e ++ " on the JSON: " ++ BS.unpack jsonString
+ handle (Fail _ _ e) = Left $ ParseError e
+ handle (Partial k) = handle $ k ""
View
@@ -7,41 +7,23 @@ import System.IO (hFlush, stdout)
-- this is all used for writeKey:
import Trajectory.Private
-import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Data.ByteString.Lazy as BS
-import Data.Aeson (encode, toJSON, Value(..))
main = do
args <- getArgs
- let profileName = getProfileNameFrom args
- configFileName <- getConfigFileName
+ (config, specificArgs) <- getConfig args
key <- getKey
- writeKey configFileName profileName key
+ writeKey config key
return ()
-getProfileNameFrom args =
- fromMaybe "default" $ args `elementAfter` "--profile"
-
getKey = promptWhile isBlank "API key: "
-writeKey configFileName profileName key = do
- configFileName <- getConfigFileName
- priorConfig <- getConfig
- let config = M.insert (T.pack profileName) (String $ T.pack key) priorConfig
- json = toJSON config
- BS.writeFile configFileName $ encode json
+writeKey config key =
+ let configUpdater = getConfigUpdater config
+ updatedConfig = configUpdater key in
+ getConfigWriter updatedConfig
-- generally useful functions below; maybe they exist elsewhere:
-elementAfter [] _ = Nothing
-elementAfter (x:xs) match
- | x == match = nextElement xs
- | otherwise = elementAfter xs match
- where
- nextElement [] = Nothing
- nextElement (result:_) = Just result
-
promptWhile p prompt = loop
where
loop = do
View
@@ -5,12 +5,47 @@ import System.Environment (getEnv)
import Data.Aeson (json, Value(..))
import Data.Attoparsec (parse, Result(..))
-getConfig = do
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.ByteString.Lazy as LBS
+import Data.Aeson (encode, toJSON, Value(..))
+import Data.Maybe (fromMaybe, fromJust)
+
+data Config = Config {
+ getConfigKey :: String
+ ,getConfigUpdater :: String -> Config
+ ,getConfigWriter :: IO ()
+}
+
+mkConfig map args =
+ Config {
+ getConfigKey =
+ let (String key) = fromJust $ M.lookup (T.pack profileName) map in
+ T.unpack key
+ ,getConfigUpdater = \newKey ->
+ let newMap = M.insert (T.pack profileName) (String $ T.pack newKey) map in
+ mkConfig newMap args
+ ,getConfigWriter = do
+ configFileName <- getConfigFileName
+ LBS.writeFile configFileName $ encode $ toJSON map
+ }
+ where
+ profileName = fromMaybe "default" $ args `elementAfter` "--profile"
+
+ elementAfter [] _ = Nothing
+ elementAfter (x:xs) match
+ | x == match = nextElement xs
+ | otherwise = elementAfter xs match
+ where
+ nextElement [] = Nothing
+ nextElement (result:_) = Just result
+
+getConfig args = do
configFileName <- getConfigFileName
jsonString <- BS.readFile configFileName
let (Done _ config) = parse json jsonString
(Object mapping) = config
- return mapping
+ return $ (mkConfig mapping args, args)
getConfigFileName = do
getEnv "TRAJECTORY_CONFIG_FILE"

0 comments on commit fe7366f

Please sign in to comment.