import Control.Monad (when) import qualified Data.ByteString.Char8 as C import Data.Char (isDigit) import Data.Default (def) import Network.MPD (withMPD, clear, status, stState) import Options.Applicative import Options.Applicative.Types (ParserPrefs, ParserInfo) import System.Directory (createDirectoryIfMissing) import System.Environment (getArgs, getProgName) import System.Exit (exitWith, exitSuccess, ExitCode(..)) import System.IO ( openFile, IOMode(AppendMode) , hPutStr, stdout, stderr, SeekMode(..) ) import System.Log.FastLogger (mkLogger, Logger) import System.Posix.Daemon import System.Posix.Files (stdFileMode) import System.Posix.IO ( fdWrite, createFile, setLock , LockRequest(..) ) import System.Posix.Process (getProcessID) import Radio import Radio.Cmd import Radio.Douban import Radio.Jing data Options = Options { optCommand :: Command , optDaemon :: Bool } deriving (Eq, Show) data Command = CmdFM CmdSubCommand | DoubanFM DoubanSubCommand | JingFM JingSubCommand | Status | Kill deriving (Eq, Show) data CmdSubCommand = CmdListen String | CmdGenreList deriving (Eq, Show) data DoubanSubCommand = DoubanListen String | DoubanHot | DoubanTrending | DoubanSearch String deriving (Eq, Show) data JingSubCommand = JingListen String deriving (Eq, Show) type Keywords = String optParser :: Parser Options optParser = Options <$> subparser ( command "cmd" (info (helper <*> cmdOptions) (progDesc "cmd.fm commander")) <> command "douban" (info (helper <*> doubanOptions) (progDesc "douban.fm commander")) <> command "jing" (info (helper <*> jingOptions) (progDesc "jing.fm commander")) <> command "status" (info (pure Status) (progDesc "show current status")) <> command "kill" (info (pure Kill) (progDesc "kill the current running lord session")) ) <*> switch (long "no-daemon" <> help "don't detach from console") main :: IO () main = do o <- execParser' $ info (helper <*> optParser) (fullDesc <> header "Lord: radio commander") let nodaemon = optDaemon o case optCommand o of CmdFM subCommand -> case subCommand of CmdListen genre -> listen nodaemon (cmd genre) CmdGenreList -> cmdGenres DoubanFM subCommand -> case subCommand of DoubanListen key -> listen nodaemon (douban key) DoubanHot -> doubanHot DoubanTrending -> doubanTrending DoubanSearch key -> doubanSearch key JingFM (JingListen key) -> jingListen nodaemon key Status -> lordStatus Kill -> killLord -- Taken from Options.Applicative.Extra execParser' :: ParserInfo a -> IO a execParser' = customExecParser' (prefs idm) -- Taken from Options.Applicative.Extra customExecParser' :: ParserPrefs -> ParserInfo a -> IO a customExecParser' pprefs pinfo = do args <- getArgs -- My modification! -- Run lord with no args is equivalent to run lord status. when (null args) $ lordStatus >> exitSuccess case execParserPure pprefs pinfo args of Right a -> return a Left failure -> do progn <- getProgName let c = errExitCode failure msg <- errMessage failure progn case c of ExitSuccess -> putStr msg _ -> hPutStr stderr msg exitWith c cmdOptions :: Parser Command cmdOptions = CmdFM <$> subparser ( command "listen" (info (helper <*> (CmdListen <$> argument str (metavar "GENRE"))) (progDesc "Provide genre to listen to cmd.fm")) <> command "genres" (info (pure CmdGenreList) (progDesc "List available genres")) ) doubanOptions :: Parser Command doubanOptions = DoubanFM <$> subparser ( command "listen" (info (helper <*> (DoubanListen <$> argument str (metavar "[ | ]"))) (progDesc "Provide cid/musician to listen to douban.fm")) <> command "search" (info (helper <*> (DoubanSearch <$> argument str (metavar "KEYWORDS"))) (progDesc "search channels")) <> command "hot" (info (pure DoubanHot) (progDesc "hot channels")) <> command "trending" (info (pure DoubanTrending) (progDesc "trending up channels")) ) jingOptions :: Parser Command jingOptions = JingFM <$> subparser ( command "listen" (info (helper <*> (JingListen <$> argument str (metavar "KEYWORDS"))) (progDesc "Provide keywords to listen to jing.fm")) ) cmdGenres :: IO () cmdGenres = genres >>= pprGenres doubanHot :: IO () doubanHot = hot >>= pprChannels doubanTrending :: IO () doubanTrending = trending >>= pprChannels doubanSearch :: String -> IO () doubanSearch key = search key >>= pprChannels cmd :: Keywords -> Radio.Param Cmd cmd = Genre douban :: Keywords -> Radio.Param Douban douban k | isChId k = Cid $ read k | otherwise = Musician k where isChId = and . fmap isDigit jingListen :: Bool -> Keywords -> IO () jingListen nodaemon k = do tok <- readToken k case tok of Just tok' -> do putStrLn $ "Welcome back, " ++ C.unpack (nick tok') listen nodaemon tok' _ -> login k >>= listen nodaemon listen :: Radio a => Bool -> Radio.Param a -> IO () listen nodaemon param = do -- Make sure ~/.lord exists getLordDir >>= createDirectoryIfMissing False pid <- getPidFile logger <- if nodaemon then mkLogger True stdout else getLogFile >>= flip openFile AppendMode >>= mkLogger True let listen' = play logger param [] running <- isRunning pid when running $ killAndWait pid if nodaemon then runInForeground pid listen' else runDetached (Just pid) def listen' -- Partially taken from System.Posix.Daemon module runInForeground :: FilePath -> IO () -> IO () runInForeground pidFile program = do fd <- createFile pidFile stdFileMode setLock fd (WriteLock, AbsoluteSeek, 0, 0) pid <- getProcessID fdWrite fd (show pid) program killLord :: IO () killLord = withMPD clear >> getPidFile >>= kill lordStatus :: IO () lordStatus = do running <- getPidFile >>= isRunning status <- if running then do st <- fmap stState <$> withMPD status let state = case st of Right s -> show s Left err -> error $ show err song <- getStateFile >>= readFile return $ "[" ++ state ++ "] " ++ song else return "Not running!" putStrLn status