nikepub-1.0: nikepub.hs

module Main (main)
where

import Codemanic.NikeRuns
import Codemanic.Blogging
import System.Console.GetOpt
import System
import IO
import Control.Monad
import Data.Maybe
import Web.Twitter.Fetch
import Web.Twitter.Monad
import System.Environment

data Options = Options {
  nikeId :: Int,
  templateDir :: String,
  chartWidth :: Int,
  chartHeight :: Int,
  mtUser :: Maybe String,
  mtPassword :: Maybe FilePath,
  mtUrl :: Maybe String,
  twitterUser :: Maybe String,
  twitterPassword :: Maybe FilePath,
  message :: Maybe String
} deriving (Eq, Show)

defaultOptions :: Options
defaultOptions = Options {
  nikeId = 0,
  templateDir = "",
  chartWidth = 600,
  chartHeight = 200,
  mtUser = Nothing,
  mtPassword = Nothing,
  mtUrl = Nothing,
  twitterUser = Nothing,
  twitterPassword = Nothing,
  message = Nothing
}

options :: [ OptDescr (Options -> IO Options) ]
options = 
  [ Option "" ["templates"]
        (ReqArg
            (\arg opt -> return opt { templateDir = arg })
            "DIR")
        "template directory"
 
    , Option "u" ["id"]
        (ReqArg
            (\arg opt -> return opt { nikeId = (read arg) })
            "INT")
        "nike+ user id"

    , Option "" ["mtUser"]
        (ReqArg
            (\arg opt -> return opt { mtUser = Just arg })
            "STRING")
        "mt user"

    , Option "" ["mtPassword"]
        (ReqArg
            (\arg opt -> return opt { mtPassword = Just arg })
            "FILEPATH")
        "mt password file"

    , Option "" ["mtUrl"]
        (ReqArg
            (\arg opt -> return opt { mtUrl = Just arg })
            "STRING")
        "mt url"

    , Option "" ["twitterUser"]
        (ReqArg
            (\arg opt -> return opt { twitterUser = Just arg })
            "STRING")
        "twitter user"

    , Option "" ["twitterPassword"]
        (ReqArg
            (\arg opt -> return opt { twitterPassword = Just arg })
            "FILEPATH")
        "twitter password file"

    , Option "m" ["message"]
        (ReqArg
            (\arg opt -> return opt { message = Just arg })
            "STRING")
        "message"
 
    , Option [] ["chartWidth"]
        (ReqArg
            (\arg opt -> return opt { chartWidth = read arg })
            "INT")
        "chart width"

    , Option [] ["chartHeight"]
        (ReqArg
            (\arg opt -> return opt { chartHeight = read arg })
            "INT")
        "chart height"

    , Option "v" ["version"]
        (NoArg
            (\_ -> do
                hPutStrLn stderr "Version 1.00"
                exitWith ExitSuccess))
        "Print version"
 
    , Option "h" ["help"]
        (NoArg
            (\_ -> do
    	        prg <- getProgName
                hPutStrLn stderr (usageInfo prg options)
                exitWith ExitSuccess))
        "Show help"
    ]

nikepubOpts :: [String] -> IO Options
nikepubOpts args = do
    case getOpt RequireOrder options args of
      (o,n,[]  ) -> foldl (>>=) (return defaultOptions) o
      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
  where header = "Usage: nikepub [OPTION...]"

tweet :: NikeRun -> Options -> IO ()
tweet nr opts = do
  let cw = chartWidth opts
  let ch = chartHeight opts
  case (twitterUser opts) of
    Just twu -> do
      twitterMsg <- renderNikeRun cw ch (templateDir opts) "twitter_status" nr ""
      twitterPswd <- readFile (fromJust $ twitterPassword opts)
      putStrLn $ "tweeting update " ++ twitterMsg
      runTM (AuthUser twu twitterPswd)
        $ postMethod
        $ restCall "update.json" (arg "status" twitterMsg [])
      putStrLn "done tweeting"
      return ()
    Nothing -> return ()
 
blog :: NikeRun -> Options -> IO ()
blog nr opts = do
  let cw = chartWidth opts
  let ch = chartHeight opts
  case (mtUrl opts) of 
    Just u -> do
      mtTitle <- renderNikeRun cw ch (templateDir opts) "mt_title" nr ""
      mtBody  <- renderNikeRun cw ch (templateDir opts) "mt_body" nr (fromMaybe "" (message opts))
      mtPswd <- readFile (fromJust $ mtPassword opts)
      let blogEntry = BlogEntry {
         title = mtTitle,
         body = mtBody,
         keywords = ["running"],
         publishTime = (startTime nr) }
      let blog = Blog {
         url = u,
         user = (fromJust $ mtUser opts),
         password = mtPswd,         
         blogId = 1}
      publish blog blogEntry
    Nothing  -> return ()
  
main :: IO ()
main = do
  args <- getArgs
  opts <- nikepubOpts args
  let userId = (nikeId opts)
  putStrLn $ "fetching most recent run for nike user " ++ (show userId)
  runId <- getMostRecentNikeRunId userId
  putStrLn $ "fetching run " ++ (show runId)
  nr <- getNikeRun userId runId
  blog nr opts
  tweet nr opts