diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright foreverbell (c) 2016 + +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 foreverbell 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,45 @@ +# netease-fm + +网易云音乐客户端。用 Haskell 编写。 + +参考 [musicbox](https://github.com/darknessomi/musicbox)。 + +## 安装 + +```bash +$ sudo apt-get install mpg123 aria2 +$ git clone https://github.com/foreverbell/netease-fm +$ cd netease-fm +$ cabal install +$ fm +``` + +建议使用 stack，`stack.yaml` 添加 `extra-deps` 项使用 `brick-0.6.4`。 + +```yaml +flags: {} +extra-package-dbs: [] +extra-deps: +- brick-0.6.4 +- vty-5.5.0 +resolver: lts-6.27 +``` + +```bash +$ stack install +$ fm +``` + +## 快捷键 + + + + + + + + + + + +
Space / Enter 确认 / 播放 / 暂停
Esc 停止 / 返回上一级菜单
n 播放下一首歌曲
o 播放模式选择
c 缓存选中歌曲
C 删除选中歌曲的缓存
- 减小音量
= 增大音量
m 静音 / 取消静音
diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,39 @@ +module Main where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Cont +import Data.IORef +import System.Directory (getHomeDirectory, createDirectoryIfMissing) + +import FM.FM +import qualified FM.NetEase as NetEase + +import qualified UI.Black as Black +import qualified UI.Login as Login +import qualified UI.Menu as Menu +import qualified UI.Player as Player + +import Types + +getCache :: IO FilePath +getCache = do + root <- (++ "/.fm") <$> getHomeDirectory + createDirectoryIfMissing True root + let cache = root ++ "/cache" + createDirectoryIfMissing True cache + return cache + +main :: IO () +main = do + netEaseSession <- newIORef Nothing + cache <- initCache =<< getCache + evalContT $ do + source <- Menu.menuSelection [ NetEaseFM, NetEaseDailyRecommendation, NetEasePlayLists, LocalCache ] Nothing "播放源" + session <- Login.login source netEaseSession cache + case source of + NetEasePlayLists -> do + playLists <- liftIO $ Black.black Nothing (runSession session NetEase.fetchPlayLists) return + source <- Menu.menuSelection [ NetEasePlayList id title | (id, title) <- playLists ] Nothing (show1 NetEasePlayLists) + Player.musicPlayer source session cache + _ -> Player.musicPlayer source session cache + Black.black (Just "缓存队列中有任务，缓存完毕后自动退出。") (waitAllCacheTasks cache) return diff --git a/exe/Types.hs b/exe/Types.hs new file mode 100644 --- /dev/null +++ b/exe/Types.hs @@ -0,0 +1,53 @@ +module Types ( + Show1 (..) +, MusicSource (..) +, PlayMode (..) +, isLocal +, requireLogin +, defaultPlayMode + +, runCache, runSession, runPlayer +, Cache +, IsSession, SomeSession (..) +, Player, PlayerState (..), isStopped +) where + +import FM.FM + +class Show1 a where + show1 :: a -> String + +data MusicSource = NetEaseFM + | NetEaseDailyRecommendation + | NetEasePlayLists + | NetEasePlayList Int String + | LocalCache + deriving (Eq, Ord) + +data PlayMode = Stream | LoopOne | LoopAll | Shuffle + deriving (Eq, Ord, Enum, Bounded) + +instance Show1 MusicSource where + show1 NetEaseFM = "网易云音乐私人兆赫" + show1 NetEaseDailyRecommendation = "网易云音乐每日歌曲推荐" + show1 NetEasePlayLists = "网易云音乐用户歌单" + show1 (NetEasePlayList _ title) = title + show1 LocalCache = "本地缓存" + +instance Show1 PlayMode where + show1 Stream = "流" + show1 LoopOne = "单曲循环" + show1 LoopAll = "列表循环" + show1 Shuffle = "随机播放" + +isLocal :: MusicSource -> Bool +isLocal LocalCache = True +isLocal _ = False + +requireLogin :: MusicSource -> Bool +requireLogin LocalCache = False +requireLogin _ = True + +defaultPlayMode :: MusicSource -> PlayMode +defaultPlayMode NetEaseFM = Stream +defaultPlayMode _ = LoopAll diff --git a/exe/UI/Black.hs b/exe/UI/Black.hs new file mode 100644 --- /dev/null +++ b/exe/UI/Black.hs @@ -0,0 +1,45 @@ +module UI.Black ( + black +) where + +import qualified Brick.Main as UI +import qualified Brick.Widgets.Center as UI +import qualified Brick.Widgets.Core as UI +import qualified Brick.Types as UI +import qualified Graphics.Vty as UI +import qualified UI.Extra as UI + +import Control.Concurrent.Chan (newChan, writeChan) +import Control.Monad.IO.Class (liftIO) +import Data.Default.Class +import Data.Maybe (fromMaybe) + +data Event = Event UI.Event | Ohayou | Oyasumi +type State a b = (String, IO a, a -> IO b, Maybe b) + +blackEvent :: State a b -> Event -> UI.EventM (UI.Next (State a b)) +blackEvent (t, m, f, _) Ohayou = do + m' <- liftIO m + UI.suspendAndResume $ do + r <- f m' + return (t, m, f, Just r) +blackEvent state Oyasumi = UI.halt state +blackEvent state _ = UI.continue state + +blackApp :: UI.App (State a b) Event +blackApp = UI.App { UI.appDraw = \(t, _, _, _) -> [UI.center (UI.str t)] + , UI.appStartEvent = return + , UI.appHandleEvent = blackEvent + , UI.appAttrMap = const UI.defaultAttributeMap + , UI.appLiftVtyEvent = Event + , UI.appChooseCursor = UI.neverShowCursor + } + +black :: Maybe String -> IO a -> (a -> IO b) -> IO b +black t m f = do + chan <- newChan + writeChan chan Ohayou + writeChan chan Oyasumi + let title = fromMaybe [] t + (_, _, _, Just r) <- UI.customMain (UI.mkVty def) chan blackApp (title, m, f, Nothing) + return r diff --git a/exe/UI/Extra.hs b/exe/UI/Extra.hs new file mode 100644 --- /dev/null +++ b/exe/UI/Extra.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module UI.Extra ( + defaultAttributeMap +, mkFocused, mkUnfocused +, mkYellow +, mkCyan +, mkWhite +, mkRed +, mkGreen +, separator +) where + +import Brick.AttrMap +import Brick.Widgets.Core +import Brick.Types +import Data.Default.Class +import qualified Graphics.Vty as V + +mkFocused :: String -> String +mkFocused = (++) "~> " + +mkUnfocused :: String -> String +mkUnfocused = (++) " " + +mkYellow :: Widget -> Widget +mkYellow = withAttr "yellow" + +mkCyan :: Widget -> Widget +mkCyan = withAttr "cyan" + +mkWhite :: Widget -> Widget +mkWhite = withAttr "white" + +mkRed :: Widget -> Widget +mkRed = withAttr "red" + +mkGreen :: Widget -> Widget +mkGreen = withAttr "green" + +defaultAttributeMap :: AttrMap +defaultAttributeMap = attrMap def $ map comb [ ("yellow", V.yellow) + , ("cyan", V.cyan) + , ("white", V.white) + , ("red", V.red) + , ("green", V.green) + ] + where comb (t, c) = (t, V.defAttr `V.withForeColor` c) + +separator :: Widget +separator = str " " diff --git a/exe/UI/Login.hs b/exe/UI/Login.hs new file mode 100644 --- /dev/null +++ b/exe/UI/Login.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module UI.Login ( + login +) where + +import qualified Brick.Main as UI +import qualified Brick.Types as UI +import qualified Brick.Widgets.Center as UI +import qualified Brick.Widgets.Core as UI +import Brick.Widgets.Core ((<+>)) +import qualified Brick.Widgets.Edit as UI +import qualified Graphics.Vty as UI +import qualified UI.Extra as UI + +import Control.Concurrent.Chan (newChan, writeChan) +import Control.Exception (SomeException, try) +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Cont (ContT (..)) +import Data.Default.Class +import Data.IORef +import System.Directory (createDirectoryIfMissing, getHomeDirectory) + +import qualified FM.Cache as Cache +import qualified FM.NetEase as NetEase +import Types + +getConfig :: (MonadIO m) => m FilePath +getConfig = liftIO $ do + dir <- (++ "/.fm") <$> getHomeDirectory + createDirectoryIfMissing True dir + return $ dir ++ "/login.conf" + +readLoginConfig :: (MonadIO m) => m (String, String) +readLoginConfig = liftIO $ do + conf <- getConfig + [userName, password] <- take 2 . lines <$> readFile conf + return (userName, password) + +writeLoginConfig :: (MonadIO m) => (String, String) -> m () +writeLoginConfig (userName, password) = liftIO $ do + conf <- getConfig + writeFile conf (unlines [userName, password]) + +data Event = Event UI.Event | Hi | Hello | Goodbye + +data EditorType = UserNameEditor | PasswordEditor + deriving (Show) + +type NetEaseSavedSession = IORef (Maybe SomeSession) + +data State = State { + currentEditor :: EditorType +, userNameEditor :: UI.Editor +, passwordEditor :: UI.Editor +, musicSource :: MusicSource +, netEaseSession :: NetEaseSavedSession +, cache :: Cache +, onGreetings :: Bool +, postEvent :: Event -> IO () +, continuation :: SomeSession -> IO () +} + +editorName :: EditorType -> UI.Name +editorName e = UI.Name (show e) + +selectEditor :: State -> UI.Editor +selectEditor State {..} = case currentEditor of + UserNameEditor -> userNameEditor + PasswordEditor -> passwordEditor + +switchEditor :: State -> State +switchEditor state@State {..} = state { currentEditor = newEditor } + where + newEditor = case currentEditor of + UserNameEditor -> PasswordEditor + PasswordEditor -> UserNameEditor + +loginDraw :: State -> [UI.Widget] +loginDraw State {..} = [ui] + where + ui = UI.vCenter $ if onGreetings + then UI.str [] + else UI.vBox [ UI.mkYellow $ UI.hCenter $ UI.str "网易通行证登陆" + , UI.separator + , UI.hCenter $ UI.str "账号: " <+> UI.hLimit 15 (UI.vLimit 1 $ UI.renderEditor userNameEditor) + , UI.hCenter $ UI.str "密码: " <+> UI.hLimit 15 (UI.vLimit 1 $ UI.renderEditor passwordEditor) + ] + +loginEvent :: State -> Event -> UI.EventM (UI.Next State) +loginEvent state@State {..} event = case event of + Hi -> do + session <- if isLocal musicSource + then Cache.initSession cache + else NetEase.initSession True + UI.suspendAndResume $ continuation session >> postEvent Goodbye >> return state + + Hello -> do + session <- liftIO $ try $ do + mSession <- readIORef netEaseSession + case mSession of + Just session -> return session + Nothing -> do + (userName, password) <- readLoginConfig + session <- NetEase.initSession True + runSession session (NetEase.login userName password) + writeIORef netEaseSession (Just session) + return session + case session of + Left (_ :: SomeException) -> liftIO (writeIORef netEaseSession Nothing) >> UI.continue state { onGreetings = False } + Right session -> UI.suspendAndResume $ continuation session >> postEvent Goodbye >> return state + + Goodbye -> UI.halt state + + Event (UI.EvKey UI.KEsc []) -> UI.halt state + + Event (UI.EvKey UI.KEnter []) -> case currentEditor of + PasswordEditor -> do + let [userName] = UI.getEditContents userNameEditor + let [password] = NetEase.encryptPassword <$> UI.getEditContents passwordEditor + session <- NetEase.initSession True + liftIO $ do + runSession session (NetEase.login userName password) + writeLoginConfig (userName, password) + writeIORef netEaseSession (Just session) + UI.suspendAndResume $ continuation session >> postEvent Goodbye >> return state + UserNameEditor -> UI.continue $ switchEditor state + + Event (UI.EvKey (UI.KChar '\t') []) -> UI.continue $ switchEditor state + Event (UI.EvKey UI.KBackTab []) -> UI.continue $ switchEditor state + + Event event -> do + editor <- UI.handleEvent event (selectEditor state) + UI.continue $ case currentEditor of + UserNameEditor -> state { userNameEditor = editor } + PasswordEditor -> state { passwordEditor = editor } + +loginCursor :: State -> [UI.CursorLocation] -> Maybe UI.CursorLocation +loginCursor state = UI.showCursorNamed (editorName $ currentEditor state) + +loginApp :: UI.App State Event +loginApp = UI.App { UI.appDraw = loginDraw + , UI.appChooseCursor = loginCursor + , UI.appHandleEvent = loginEvent + , UI.appStartEvent = return + , UI.appAttrMap = const UI.defaultAttributeMap + , UI.appLiftVtyEvent = Event + } + +loginCont :: MusicSource -> NetEaseSavedSession -> Cache -> (SomeSession -> IO ()) -> IO () +loginCont source netEaseSession cache continuation = void $ do + let editor1 = UI.editor (editorName UserNameEditor) (UI.str . unlines) Nothing [] + let editor2 = UI.editor (editorName PasswordEditor) (\[s] -> UI.str $ replicate (length s) '*') Nothing [] + chan <- newChan + let postEvent = writeChan chan + postEvent $ if requireLogin source then Hello else Hi + UI.customMain (UI.mkVty def) chan loginApp State { currentEditor = UserNameEditor + , userNameEditor = editor1 + , passwordEditor = editor2 + , musicSource = source + , netEaseSession = netEaseSession + , cache = cache + , onGreetings = True + , postEvent = postEvent + , continuation = continuation + } + +login :: MusicSource -> NetEaseSavedSession -> Cache -> ContT () IO SomeSession +login source netEaseSession cache = ContT (loginCont source netEaseSession cache) diff --git a/exe/UI/Menu.hs b/exe/UI/Menu.hs new file mode 100644 --- /dev/null +++ b/exe/UI/Menu.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} + +module UI.Menu ( + menuSelection +, menuSelection_ +) where + +import qualified Brick.Main as UI +import qualified Brick.Types as UI +import qualified Brick.Widgets.Center as UI +import qualified Brick.Widgets.Core as UI +import qualified Graphics.Vty as UI +import qualified UI.Extra as UI + +import Control.Monad (void) +import Control.Monad.Cont (ContT (..)) +import Data.List (elemIndex) +import Data.Maybe (fromMaybe) +import qualified Data.Sequence as S + +import Types + +data State a = State { + menuSequence :: S.Seq a +, uiTitle :: String +, currentIndex :: Int +, continuation :: Maybe (a -> IO ()) +, isSelected :: Bool +} + +menuSelectionDraw :: (Show1 a) => State a -> [UI.Widget] +menuSelectionDraw State {..} = [ui] + where + ui = UI.vCenter $ UI.vLimit 15 $ UI.vBox [ title, UI.str " ", menu ] + title = UI.mkYellow $ UI.hCenter $ UI.str uiTitle + menu = UI.viewport "vp" UI.Vertical $ UI.hCenter $ UI.vBox $ do + index <- [0 .. S.length menuSequence - 1] + let mkItem | currentIndex == index = UI.mkCyan . UI.str . UI.mkFocused + | otherwise = UI.mkWhite . UI.str . UI.mkUnfocused + return $ mkItem $ show1 $ menuSequence `S.index` index + +menuSelectionEvent :: State a -> UI.Event -> UI.EventM (UI.Next (State a)) +menuSelectionEvent state@State {..} event = case event of + UI.EvKey UI.KEsc [] -> UI.halt state + + UI.EvKey (UI.KChar ' ') [] -> menuSelectionEvent state (UI.EvKey UI.KEnter []) + UI.EvKey UI.KEnter [] -> emptyGuard $ case continuation of + Just continuation -> UI.suspendAndResume $ do + continuation (menuSequence `S.index` currentIndex) + return state { isSelected = True } + Nothing -> UI.halt state { isSelected = True } + + UI.EvKey UI.KDown [] -> emptyGuard $ UI.continue $ state { currentIndex = (currentIndex + 1) `mod` S.length menuSequence } + + UI.EvKey UI.KUp [] -> emptyGuard $ UI.continue $ state { currentIndex = (currentIndex - 1) `mod` S.length menuSequence } + + _ -> UI.continue state + + where emptyGuard m = if S.null menuSequence then UI.continue state else m + +menuSelectionApp :: (Show1 a) => UI.App (State a) UI.Event +menuSelectionApp = UI.App { UI.appDraw = menuSelectionDraw + , UI.appStartEvent = return + , UI.appHandleEvent = menuSelectionEvent + , UI.appAttrMap = const UI.defaultAttributeMap + , UI.appLiftVtyEvent = id + , UI.appChooseCursor = UI.neverShowCursor + } + +menuSelectionCont :: (Show1 a, Eq a) => [a] -> Maybe a -> String -> Maybe (a -> IO ()) -> IO (Maybe Int) +menuSelectionCont menu def title continuation = do + let startIndex = maybe 0 (\def -> fromMaybe 0 (elemIndex def menu)) def + let state = State { menuSequence = S.fromList menu + , uiTitle = title + , currentIndex = startIndex + , continuation = continuation + , isSelected = False + } + State {..} <- UI.defaultMain menuSelectionApp state + return $ if isSelected then Just currentIndex else Nothing + +menuSelection :: (Show1 a, Eq a) => [a] -> Maybe a -> String -> ContT () IO a +menuSelection menu def title = ContT (void . menuSelectionCont menu def title . Just) + +menuSelection_ :: (Show1 a, Eq a) => [a] -> Maybe a -> String -> IO (Maybe a) +menuSelection_ menu def title = do + result <- menuSelectionCont menu def title Nothing + return $ case result of + Just id -> Just (menu !! id) + Nothing -> Nothing diff --git a/exe/UI/Player.hs b/exe/UI/Player.hs new file mode 100644 --- /dev/null +++ b/exe/UI/Player.hs @@ -0,0 +1,299 @@ +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} + +module UI.Player ( + musicPlayer +) where + +import qualified Brick.Main as UI +import qualified Brick.Types as UI +import qualified Brick.Widgets.Center as UI +import qualified Brick.Widgets.Core as UI +import qualified Graphics.Vty as UI +import qualified UI.Extra as UI + +import Control.Concurrent.Chan (writeChan, newChan) +import Control.Concurrent.STM.TVar +import Control.Monad (void, when) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Cont (ContT (..)) +import Control.Monad.STM (atomically) +import Data.Default.Class +import Data.Foldable (toList) +import Data.List (intercalate) +import Data.Maybe (isJust, fromJust) +import qualified Data.Sequence as S +import Text.Printf (printf) +import System.Random (randomRIO) +import System.Process (callProcess) + +import qualified FM.FM as FM +import qualified FM.Song as Song +import qualified FM.Cache as Cache +import qualified FM.NetEase as NetEase + +import UI.Menu +import Types + +data State = State { + session :: SomeSession +, player :: Player +, cache :: Cache +, source :: MusicSource +, playMode :: PlayMode +, playSequence :: S.Seq Song.Song +, stopped :: Bool +, currentIndex :: Int +, focusedIndex :: Int +, progress :: (Double, Double) +, currentLyrics :: String +, postEvent :: Event -> IO () +, autoProceed :: Bool +} + +data Event = VtyEvent UI.Event + | UserEventFetchMore + | UserEventPending Bool + | UserEventUpdateProgress (Double, Double) + | UserEventUpdateLyrics String + +liftCache State {..} m = liftIO $ runCache cache m +liftSession State {..} m = liftIO $ runSession session m +liftPlayer State {..} m = liftIO $ runPlayer player m + +fetch :: (MonadIO m) => State -> m [Song.Song] +fetch state@State {..} = case source of + NetEaseFM -> liftSession state NetEase.fetchFM + NetEaseDailyRecommendation -> liftSession state NetEase.fetchRecommend + NetEasePlayLists -> undefined + NetEasePlayList id _ -> liftSession state (NetEase.fetchPlayList id) + LocalCache -> liftSession state Cache.fetchCache + +fetchUrl :: (MonadIO m) => State -> Song.Song -> m (Maybe String) +fetchUrl state@State {..} song = if isLocal source + then liftSession state (Cache.fetchUrl song) + else do + localPath <- liftCache state (Cache.lookupCache (Song.uid song)) + case localPath of + Just path -> return $ Just path + Nothing -> liftSession state (NetEase.fetchUrl song) + +fetchLyrics :: (MonadIO m) => State -> Song.Song -> m Song.Lyrics +fetchLyrics state@State {..} song = if isLocal source + then liftSession state (Cache.fetchLyrics song) + else liftSession state (NetEase.fetchLyrics song) + +fetchMore :: (MonadIO m) => State -> m State +fetchMore state@State {..} = do + new <- S.fromList <$> fetch state + return state { playSequence = playSequence S.>< new } + +play :: (MonadIO m) => State -> m State +play state@State {..} + | currentIndex == 0 = return state + | otherwise = do + let onBegin () = let Song.Song {..} = playSequence `S.index` (currentIndex - 1) in callProcess "notify-send" [title, intercalate " / " artists ++ "\n" ++ album] + let onTerminate e = when e (postEvent (UserEventPending False)) + let onProgress p = postEvent (UserEventUpdateProgress p) + let onLyrics l = postEvent (UserEventUpdateLyrics l) + liftPlayer state $ FM.play (playSequence `S.index` (currentIndex - 1)) (fetchUrl state) (fetchLyrics state) onBegin onTerminate onProgress onLyrics + return state { focusedIndex = currentIndex + , stopped = False + , progress = (0, 0) + , currentLyrics = [] + , autoProceed = True } + +pause :: (MonadIO m) => State -> m State +pause state = do + liftPlayer state FM.pause + return state { autoProceed = False } + +resume :: (MonadIO m) => State -> m State +resume state = do + liftPlayer state FM.resume + return state { autoProceed = True } + +stop :: (MonadIO m) => State -> m State +stop state = do + liftPlayer state FM.stop + return state { stopped = True + , progress = (0, 0) + , currentLyrics = [] + , autoProceed = False } + +setVolume :: (MonadIO m) => State -> Int -> m State +setVolume state@State {..} d = do + let newVolume = max 0 $ min 100 $ FM.playerVolume player + d + let newState = state { player = player { FM.playerVolume = newVolume } } + liftPlayer newState FM.updateVolume + return newState + +toggleMute :: (MonadIO m) => State -> m State +toggleMute state@State {..} = do + let newMuted = not (FM.playerMuted player) + let newState = state { player = player { FM.playerMuted = newMuted } } + liftPlayer newState FM.updateVolume + return newState + +cacheSong :: (MonadIO m) => State -> m State +cacheSong state@State {..} = do + when (focusedIndex /= 0 && not (isLocal source)) $ do + let song = playSequence `S.index` (focusedIndex - 1) + url <- fetchUrl state song + when (isJust url) $ liftCache state $ FM.cacheSong song (fromJust url) + return state + +deleteSong :: (MonadIO m) => State -> m State +deleteSong state@State {..} = do + state <- stop state + if (focusedIndex /= 0 && isLocal source) + then liftCache state $ do + FM.deleteSong $ playSequence `S.index` (focusedIndex - 1) + let (heads, tails) = S.splitAt (focusedIndex - 1) playSequence + let newSequence = heads `mappend` S.drop 1 tails + let newIndex = if S.length tails == 1 then focusedIndex - 1 else focusedIndex + return state { playSequence = newSequence, focusedIndex = newIndex } + else return state + +musicPlayerDraw :: State -> [UI.Widget] +musicPlayerDraw State {..} = [ui] + where + formatSong Song.Song {..} = printf "%s - %s - %s" title (intercalate " / " artists) album :: String + + formatTime time = printf "%02d:%02d" minute second :: String + where (minute, second) = floor time `quotRem` 60 :: (Int, Int) + + ui = UI.vBox [UI.separator, title , UI.separator, bar1, UI.separator, bar2, UI.separator, lyrics, UI.separator, playList] + + title = UI.mkYellow $ UI.hCenter $ UI.str body + where + body | stopped = "[停止]" + | otherwise = formatSong $ playSequence `S.index` (currentIndex - 1) + + bar1 | stopped = UI.separator + | otherwise = UI.mkGreen $ UI.hCenter $ UI.str $ printf "[%s] (%s/%s)" (make '>' total occupied) (formatTime cur) (formatTime len) + where + (len, cur) = progress + ratio = if len == 0 then 0 else cur / len + total = 35 :: Int + occupied = ceiling $ fromIntegral total * ratio + make c total occupied = replicate occupied c ++ replicate (total - occupied) ' ' + + bar2 = UI.mkCyan $ UI.hCenter $ UI.str $ unwords [playModeBar, volumeBar] + where + playModeBar = printf "[播放模式: %s]" (show1 playMode) + volumeBar | FM.playerMuted player = "[静音]" + | otherwise = printf "[音量: %d%%]" (FM.playerVolume player) + + lyrics = UI.mkRed $ UI.hCenter $ UI.str $ if null currentLyrics then " " else currentLyrics + + playList = UI.viewport "vp" UI.Vertical $ UI.hCenter $ UI.vBox $ do + (song, index) <- zip (toList playSequence) [1 .. ] + let mkItem | index == focusedIndex = UI.visible . UI.mkCyan . UI.str . UI.mkFocused + | otherwise = UI.mkWhite . UI.str . UI.mkUnfocused + return $ mkItem (show index ++ ". " ++ formatSong song) + +musicPlayerEvent :: State -> Event -> UI.EventM (UI.Next State) +musicPlayerEvent state@State {..} event = case event of + UserEventFetchMore -> UI.continue =<< fetchMore state + + UserEventPending forceProceed -> do + pState <- liftIO $ atomically $ readTVar (FM.playerState player) + if (forceProceed || autoProceed) && (isStopped pState) + then do + let needMore = currentIndex == S.length playSequence && playMode == Stream + state@State {..} <- if needMore then fetchMore state else return state + nextIndex <- case playMode of + Stream -> return $ min (S.length playSequence) (currentIndex + 1) + LoopOne -> return currentIndex + LoopAll -> return $ if currentIndex + 1 > S.length playSequence then 1 else currentIndex + 1 + Shuffle -> liftIO $ randomRIO (1, S.length playSequence) + UI.continue =<< play state { currentIndex = nextIndex } + else UI.continue state + + UserEventUpdateProgress p -> UI.continue state { progress = p } + + UserEventUpdateLyrics l -> UI.continue state { currentLyrics = l } + + VtyEvent (UI.EvKey UI.KEsc []) -> if stopped + then UI.halt state + else UI.continue =<< stop state + + VtyEvent (UI.EvKey (UI.KChar ' ') []) -> musicPlayerEvent state (VtyEvent $ UI.EvKey UI.KEnter []) + VtyEvent (UI.EvKey UI.KEnter []) -> do + pState <- liftIO $ atomically $ readTVar (FM.playerState player) + UI.continue =<< case pState of + Playing _ -> if currentIndex == focusedIndex + then pause state + else do + state@State {..} <- stop state + play state { currentIndex = focusedIndex } + Paused _ -> if currentIndex == focusedIndex + then resume state + else do + state@State {..} <- stop state + play state { currentIndex = focusedIndex } + Stopped -> play state { currentIndex = focusedIndex } + + VtyEvent (UI.EvKey UI.KUp []) -> UI.continue state { focusedIndex = max 0 (focusedIndex - 1) } + + VtyEvent (UI.EvKey UI.KDown []) -> do + let needMore = focusedIndex == S.length playSequence && playMode == Stream + state@State {..} <- if needMore then liftIO (fetchMore state) else return state + UI.continue state { focusedIndex = min (S.length playSequence) (focusedIndex + 1) } + + VtyEvent (UI.EvKey (UI.KChar '-') []) -> UI.continue =<< setVolume state (-10) + + VtyEvent (UI.EvKey (UI.KChar '=') []) -> UI.continue =<< setVolume state 10 + + VtyEvent (UI.EvKey (UI.KChar 'm') []) -> UI.continue =<< toggleMute state + + VtyEvent (UI.EvKey (UI.KChar 'n') []) -> do + state <- stop state + liftIO $ postEvent (UserEventPending True) + UI.continue state + + VtyEvent (UI.EvKey (UI.KChar 'o') []) -> UI.suspendAndResume $ do + newPlayMode <- menuSelection_ [minBound .. maxBound] (Just playMode) "播放模式" + return $ case newPlayMode of + Just newPlayMode -> state { playMode = newPlayMode } + Nothing -> state + + VtyEvent (UI.EvKey (UI.KChar 'c') []) -> UI.continue =<< cacheSong state + + VtyEvent (UI.EvKey (UI.KChar 'C') []) -> UI.continue =<< deleteSong state + + _ -> UI.continue state + +musicPlayerApp :: UI.App State Event +musicPlayerApp = UI.App { UI.appDraw = musicPlayerDraw + , UI.appStartEvent = return + , UI.appHandleEvent = musicPlayerEvent + , UI.appAttrMap = const UI.defaultAttributeMap + , UI.appLiftVtyEvent = VtyEvent + , UI.appChooseCursor = UI.neverShowCursor + } + +musicPlayer_ :: MusicSource -> SomeSession -> Cache -> IO () +musicPlayer_ source session cache = void $ do + player <- FM.initPlayer + chan <- newChan + let postEvent = writeChan chan + let state = State { session = session + , player = player + , cache = cache + , source = source + , playMode = defaultPlayMode source + , playSequence = S.empty + , stopped = True + , currentIndex = 0 + , focusedIndex = 0 + , progress = (0, 0) + , currentLyrics = [] + , postEvent = postEvent + , autoProceed = False + } + postEvent UserEventFetchMore + UI.customMain (UI.mkVty def) chan musicPlayerApp state + +musicPlayer :: MusicSource -> SomeSession -> Cache -> ContT () IO () +musicPlayer source session cache = ContT (const $ musicPlayer_ source session cache) diff --git a/lib/Control/Concurrent/STM/Lock.hs b/lib/Control/Concurrent/STM/Lock.hs new file mode 100644 --- /dev/null +++ b/lib/Control/Concurrent/STM/Lock.hs @@ -0,0 +1,46 @@ +module Control.Concurrent.STM.Lock ( + Lock +, LockState (..) +, newLock +, newLockIO +, newAcquiredLock +, newAcquiredLockIO +, acquireLock +, releaseLock +, waitLock +, viewLock +) where + +import Control.Concurrent.STM +import Control.Monad (void) + +newtype Lock = Lock { un :: TMVar () } +data LockState = Acquired | Released deriving (Eq) + +newLock :: STM Lock +newLock = Lock <$> newTMVar () + +newLockIO :: IO Lock +newLockIO = Lock <$> newTMVarIO () + +newAcquiredLock :: STM Lock +newAcquiredLock = Lock <$> newEmptyTMVar + +newAcquiredLockIO :: IO Lock +newAcquiredLockIO = Lock <$> newEmptyTMVarIO + +acquireLock :: Lock -> STM () +acquireLock = takeTMVar . un + +releaseLock :: Lock -> STM () +releaseLock (Lock lock) = void $ tryPutTMVar lock () + +waitLock :: Lock -> LockState -> STM () +waitLock (Lock lock) state = case state of + Acquired -> putTMVar lock () >> takeTMVar lock + Released -> takeTMVar lock >> putTMVar lock () + +viewLock :: Lock -> STM LockState +viewLock (Lock lock) = do + locked <- isEmptyTMVar lock + return $ if locked then Acquired else Released diff --git a/lib/Data/Aeson/Extra.hs b/lib/Data/Aeson/Extra.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Aeson/Extra.hs @@ -0,0 +1,25 @@ +module Data.Aeson.Extra ( + encodeJSON +, onObject +, onArray +) where + +import qualified Data.Aeson as JSON +import qualified Data.Aeson.Encode as JSON +import qualified Data.Aeson.Types as JSON +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as BL +import Data.Text.Encoding (decodeUtf8) + +instance JSON.ToJSON BS.ByteString where + toJSON = JSON.String . decodeUtf8 + +encodeJSON :: JSON.Value -> BS.ByteString +encodeJSON = BL.toStrict . BB.toLazyByteString . JSON.encodeToBuilder + +onObject :: (JSON.Object -> JSON.Parser a) -> JSON.Value -> JSON.Parser a +onObject = JSON.withObject "Object" + +onArray :: (JSON.Array -> JSON.Parser a) -> JSON.Value -> JSON.Parser a +onArray = JSON.withArray "Array" diff --git a/lib/FM/Cache.hs b/lib/FM/Cache.hs new file mode 100644 --- /dev/null +++ b/lib/FM/Cache.hs @@ -0,0 +1,9 @@ +module FM.Cache ( + initSession +, lookupCache +, fetchCache +, fetchUrl +, fetchLyrics +) where + +import FM.CacheManager diff --git a/lib/FM/CacheManager.hs b/lib/FM/CacheManager.hs new file mode 100644 --- /dev/null +++ b/lib/FM/CacheManager.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module FM.CacheManager ( + MonadCache, runCache +, Cache +, initCache +, waitAllCacheTasks +, cacheSong +, deleteSong +, lookupCache +, initSession +, fetchCache +, fetchUrl +, fetchLyrics +) where + +import Control.Concurrent (forkIO) +import Control.Concurrent.STM.TQueue +import Control.Concurrent.STM.Lock +import Control.Exception (try, SomeException) +import Control.Monad.Reader +import Control.Monad.STM (atomically) +import qualified Crypto.Hash as C +import qualified Data.Aeson as JSON +import Data.Aeson ((.:), (.=)) +import Data.Aeson.Extra +import qualified Data.Aeson.Types as JSON +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as BL +import Data.Default.Class (def) +import Data.Maybe (fromJust, isJust) +import qualified Data.Vector as V +import System.Directory (doesFileExist, getDirectoryContents, removeFile) +import System.Exit (ExitCode (..)) +import System.IO (hClose) +import System.Process (runInteractiveProcess, waitForProcess) + +import qualified FM.NetEase as NetEase +import FM.Session +import qualified FM.Song as Song + +newtype MonadCache a = MonadCache (ReaderT Cache IO a) + deriving (Functor, Applicative, Monad, MonadIO, MonadReader Cache) + +runCache :: Cache -> MonadCache a -> IO a +runCache cache (MonadCache m) = runReaderT m cache + +hashSongId :: String -> String +hashSongId uid = uid ++ "-" ++ hash + where hash = show $ C.hashWith C.MD5 $ BS8.pack uid + +data SongWithLyrics = SongWithLyrics Song.Song Song.Lyrics + +instance JSON.FromJSON SongWithLyrics where + parseJSON = onObject $ \v -> do + let + parseArray :: (JSON.FromJSON a) => JSON.Value -> JSON.Parser [a] + parseArray = onArray $ \v -> mapM JSON.parseJSON (V.toList v) + uid <- v .: "uid" + title <- v .: "title" + album <- v .: "album" + artists <- parseArray =<< v .: "artists" + let url = Nothing + let parseLyrics = onObject $ \v -> do + time <- parseArray =<< v .: "time" + body <- parseArray =<< v .: "body" + return $ Song.Lyrics $ zip time body + lyrics <- parseLyrics =<< v .: "lyrics" + return $ SongWithLyrics Song.Song {..} lyrics + +instance JSON.ToJSON SongWithLyrics where + toJSON (SongWithLyrics Song.Song {..} (Song.Lyrics lyrics)) = + JSON.object [ "uid" .= uid + , "title" .= title + , "album" .= album + , "artists" .= array artists + , "lyrics" .= JSON.object [ "time" .= array (map fst lyrics), "body" .= array (map snd lyrics) ] + ] + where array xs = JSON.Array (V.fromList (JSON.toJSON <$> xs)) + +data Cache = Cache { + cachePath :: FilePath +, songQueue :: TQueue Song.Song +, queueLock :: Lock +} + +initCache :: (MonadIO m) => FilePath -> m Cache +initCache cachePath = do + songQueue <- liftIO newTQueueIO + queueLock <- liftIO newLockIO + netEaseSession <- NetEase.initSession True + liftIO $ forkIO $ forever $ do + song@Song.Song {..} <- atomically $ do + result <- peekTQueue songQueue + state <- viewLock queueLock + when (state == Released) (acquireLock queueLock) + return result + let hashPath = hashSongId (show uid) + (_, outHandle, errHandle, processHandle) <- runInteractiveProcess "aria2c" [ "--auto-file-renaming=false" + , "-d" + , cachePath + , "-o" + , hashPath ++ ".mp3" + , fromJust url ] + Nothing Nothing + exitCode <- waitForProcess processHandle + hClose outHandle + hClose errHandle + if exitCode == ExitSuccess + then do + lyrics <- runSession netEaseSession (NetEase.fetchLyrics song) + BL.writeFile (cachePath ++ "/" ++ hashPath ++ ".json") (JSON.encode $ SongWithLyrics song lyrics) + else do + let path = cachePath ++ "/" ++ hashPath ++ ".mp3" + void (try (removeFile path) :: IO (Either SomeException ())) + atomically $ do + readTQueue songQueue + isEmpty <- isEmptyTQueue songQueue + when isEmpty (releaseLock queueLock) + return Cache {..} + +waitAllCacheTasks :: (MonadIO m) => Cache -> m () +waitAllCacheTasks Cache {..} = liftIO $ atomically $ waitLock queueLock Released + +cacheSong :: (MonadIO m, MonadReader Cache m) => Song.Song -> String -> m () +cacheSong song url = do + Cache {..} <- ask + liftIO $ atomically $ writeTQueue songQueue (song { Song.url = Just url }) + +deleteSong :: (MonadIO m, MonadReader Cache m) => Song.Song -> m () +deleteSong Song.Song {..} = do + Cache {..} <- ask + let path = cachePath ++ "/" ++ hashSongId (show uid) + void $ forM [".mp3", ".json"] $ \suffix -> do + let fullPath = path ++ suffix + liftIO (try $ removeFile fullPath :: IO (Either SomeException ())) + +lookupCache :: (MonadIO m, MonadReader Cache m) => Int -> m (Maybe String) +lookupCache uid = do + Cache {..} <- ask + let fullPrefix = cachePath ++ "/" ++ hashSongId (show uid) + let mp3Path = fullPrefix ++ ".mp3" + let jsonPath = fullPrefix ++ ".json" + mp3Exists <- liftIO $ doesFileExist mp3Path + jsonExists <- liftIO $ doesFileExist jsonPath + return $ if mp3Exists && jsonExists + then Just mp3Path + else Nothing + +data Session = Session { + sessionCachePath :: FilePath +} + +instance IsSession Session + +initSession :: (MonadIO m) => Cache -> m SomeSession +initSession Cache {..} = return $ SomeSession (Session cachePath) + +fetchCache :: (MonadIO m, MonadReader Session m) => m [Song.Song] +fetchCache = do + Session {..} <- ask + files <- liftIO $ filterM (isValid sessionCachePath) =<< getDirectoryContents sessionCachePath + songs <- forM files $ \path -> do + let fullPath = sessionCachePath ++ "/" ++ path + song <- liftIO $ JSON.decode <$> BL.readFile fullPath + case song of + Just (SongWithLyrics song _) -> do + let url = take (length fullPath - 4) fullPath ++ "mp3" + return $ Just song { Song.url = Just url } + Nothing -> return Nothing + return $ map fromJust $ filter isJust songs + where + isValid dir path = do + let fullPath = dir ++ "/" ++ path + isFile <- doesFileExist fullPath + let uid = takeWhile (/= '-') path + let hashPath = hashSongId uid + let validFile = path == (hashPath ++ ".json") + mp3Exists <- doesFileExist (dir ++ "/" ++ hashPath ++ ".mp3") + return $ isFile && validFile && mp3Exists + +fetchUrl :: (MonadIO m, MonadReader Session m) => Song.Song -> m (Maybe String) +fetchUrl Song.Song {..} = return url + +fetchLyrics :: (MonadIO m, MonadReader Session m) => Song.Song -> m Song.Lyrics +fetchLyrics Song.Song {..} = do + song <- liftIO $ JSON.decode <$> BL.readFile (take (length (fromJust url) - 3) (fromJust url) ++ "json") + return $ case song of + Just (SongWithLyrics _ lyrics) -> lyrics + Nothing -> def diff --git a/lib/FM/FM.hs b/lib/FM/FM.hs new file mode 100644 --- /dev/null +++ b/lib/FM/FM.hs @@ -0,0 +1,22 @@ +module FM.FM ( + runCache, runSession, runPlayer + +, initPlayer +, PlayerState (..) +, Player, playerState, playerVolume, playerMuted +, isStopped +, play, pause, resume, stop, updateVolume + +, IsSession +, SomeSession (..) +, fromSession + +, Cache +, initCache +, cacheSong, deleteSong +, waitAllCacheTasks +) where + +import FM.CacheManager +import FM.Player +import FM.Session diff --git a/lib/FM/NetEase.hs b/lib/FM/NetEase.hs new file mode 100644 --- /dev/null +++ b/lib/FM/NetEase.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} + +module FM.NetEase ( + initSession +, login +, encryptPassword +, fetchFM +, fetchRecommend +, fetchPlayLists +, fetchPlayList +, fetchUrl +, fetchLyrics +) where + +import Control.Exception +import Control.Monad.IO.Class +import Control.Monad.Reader +import Control.Monad.Catch (throwM) +import qualified Data.Aeson as JSON +import Data.Aeson ((.:), (.:?)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as BL +import Data.Char (isDigit) +import Data.Default.Class +import Data.IORef +import Data.List (find) +import Data.Time.Clock (getCurrentTime) +import Data.Typeable +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Client.TLS as HTTP +import qualified Network.HTTP.Types.Header as HTTP +import qualified Network.HTTP.Types.Status as HTTP +import qualified Network.HTTP.Types.URI as HTTP +import System.Random (getStdRandom, randomR) + +import FM.Session +import qualified FM.Song as Song +import FM.NetEase.JSON +import FM.NetEase.Crypto + +class IsQuery q where + fromQuery :: q -> BS.ByteString + +instance IsQuery () where + fromQuery () = BS.empty + +data Session = Session { + sessionManager :: HTTP.Manager +, sessionUserId :: IORef Int +, sessionCsrf :: IORef String +, sessionSecure :: Bool +, sessionCookies :: IORef HTTP.CookieJar +} deriving (Typeable) + +instance IsSession Session + +data HTTPMethod = Post | Get | PostAndSaveCookies + +data NetEaseException = NetEaseHTTPException HTTP.HttpException + | NetEaseStatusCodeException Int (HTTP.Response String) + | NetEaseParseException String + | NetEaseOtherExceptipon Int (Maybe String) + deriving (Typeable, Show) + +instance Exception NetEaseException + +data ResponseMessage = ResponseMessage Int (Maybe String) + +instance JSON.FromJSON ResponseMessage where + parseJSON (JSON.Object v) = ResponseMessage <$> v .: "code" <*> v .:? "message" + parseJSON _ = fail "invalid response" + +validateJSON :: (MonadIO m) => Either String a -> (a -> m b) -> m b +validateJSON r f = case r of + Right x -> f x + Left err -> liftIO $ throwM $ NetEaseParseException err + +sendRequest :: (MonadIO m, IsQuery q) => Session -> HTTPMethod -> String -> q -> m BS.ByteString +sendRequest Session {..} method url query = liftIO $ case method of + Get -> catch get (throwM . NetEaseHTTPException) + Post -> catch (post False) (throwM . NetEaseHTTPException) + PostAndSaveCookies -> catch (post True) (throwM . NetEaseHTTPException) + where + initRequest request = do + cookies <- liftIO $ readIORef sessionCookies + return request { HTTP.requestHeaders = [ (HTTP.hAccept, "*/*") + , (HTTP.hAcceptEncoding, "gzip,deflate,sdch") + , (HTTP.hAcceptLanguage, "zh-CN,zh;q=0.8,gl;q=0.6,zh-TW;q=0.4") + , (HTTP.hConnection, "keep-alive") + , (HTTP.hContentType, "application/x-www-form-urlencoded") + , (HTTP.hHost, "music.163.com") + , (HTTP.hReferer, "http://music.163.com/search/") + ] + , HTTP.cookieJar = Just cookies + , HTTP.secure = sessionSecure + , HTTP.port = if sessionSecure then 443 else 80 + } + + post saveCookies = do + initialRequest <- initRequest =<< HTTP.parseUrl url + send saveCookies $ initialRequest { HTTP.method = "POST" + , HTTP.requestBody = HTTP.RequestBodyBS $ fromQuery query + } + + get = do + let action = mconcat [ url, "?", BS8.unpack $ fromQuery query ] + initialRequest <- initRequest =<< HTTP.parseUrl action + send False $ initialRequest { HTTP.method = "GET" } + + send saveCookies request = do + response <- fmap BL.toStrict <$> HTTP.httpLbs request sessionManager + let HTTP.Status {..} = HTTP.responseStatus response + case statusCode of + 200 -> do + when saveCookies $ do + now <- getCurrentTime + let updateCookieJar = fst . HTTP.updateCookieJar response request now + modifyIORef' sessionCookies updateCookieJar + let body = HTTP.responseBody response + validateJSON (JSON.eitherDecode (BL.fromStrict body)) $ \case + ResponseMessage 200 _ -> return body + ResponseMessage rc m -> throwM (NetEaseOtherExceptipon rc m) + _ -> throwM (NetEaseStatusCodeException statusCode (BS8.unpack <$> response)) + +initSession :: (MonadIO m) => Bool -> m SomeSession +initSession sessionSecure = liftIO $ do + sessionManager <- HTTP.newManager (if sessionSecure then HTTP.tlsManagerSettings else HTTP.defaultManagerSettings) + sessionUserId <- newIORef 0 + sessionCsrf <- newIORef [] + sessionCookies <- newIORef (HTTP.createCookieJar []) + return $ SomeSession Session {..} + +data NetEaseQuery = FetchLyrics Song.SongId + | FetchPlayLists Int + | FetchPlayList Int + | EncryptData BS.ByteString BS.ByteString + +instance IsQuery NetEaseQuery where + fromQuery (EncryptData text key) = HTTP.renderSimpleQuery False + [ ("params", text), ("encSecKey", key) ] + + fromQuery (FetchLyrics id) = HTTP.renderSimpleQuery False + [ ("os", "osx"), ("id", BS8.pack (show id)), ("lv", "-1"), ("kv", "-1"), ("tv", "-1") ] + + fromQuery (FetchPlayLists uid) = HTTP.renderSimpleQuery False + [ ("offset", "0"), ("limit", "1000"), ("uid", BS8.pack (show uid)) ] + + fromQuery (FetchPlayList id) = HTTP.renderSimpleQuery False + [ ("id", BS8.pack (show id)) ] + +createSecretKey :: (MonadIO m) => Int -> m BS.ByteString +createSecretKey n = mconcat <$> replicateM n (toHex <$> liftIO (getStdRandom $ randomR (0 :: Int, 15))) + +encryptQuery :: (MonadIO m) => BS.ByteString -> m NetEaseQuery +encryptQuery q = do + secretKey <- createSecretKey 16 + return $ EncryptData (encryptAES secretKey q) (encryptRSA secretKey) + +login :: (MonadIO m, MonadReader Session m) => String -> String -> m () +login userName password = do + session@Session {..} <- ask + let isPhone = length userName == 11 && all isDigit userName + let loginURL | isPhone = "http://music.163.com/weapi/login/cellphone" + | otherwise = "http://music.163.com/weapi/login" + request <- encryptQuery $ encodeJSON $ JSON.object $ if isPhone + then [ ("phone", JSON.toJSON $ BS8.pack userName) + , ("password", JSON.toJSON $ BS8.pack password) + , ("rememberLogin", JSON.toJSON False) + ] + else [ ("username", JSON.toJSON $ BS8.pack userName) + , ("password", JSON.toJSON $ BS8.pack password) + , ("rememberLogin", JSON.toJSON False) + ] + body <- sendRequest session PostAndSaveCookies loginURL request + validateJSON (decodeUserId body) (liftIO . writeIORef sessionUserId) + cookies <- liftIO $ HTTP.destroyCookieJar <$> readIORef sessionCookies + let csrf = BS8.unpack . HTTP.cookie_value <$> find (\HTTP.Cookie {..} -> cookie_name == "__csrf") cookies + case csrf of + Just csrf -> liftIO $ writeIORef sessionCsrf csrf + Nothing -> return () + +fetchFM :: (MonadIO m, MonadReader Session m) => m [Song.Song] +fetchFM = do + session <- ask + body <- sendRequest session Get "http://music.163.com/api/radio/get" () + validateJSON (decodeFM body) return + +fetchRecommend :: (MonadIO m, MonadReader Session m) => m [Song.Song] +fetchRecommend = do + session@Session {..} <- ask + csrf <- liftIO $ readIORef sessionCsrf + let url = "http://music.163.com/weapi/v1/discovery/recommend/songs?csrf_token=" ++ csrf + request <- encryptQuery $ encodeJSON $ JSON.object + [ ("offset", JSON.toJSON (0 :: Int)) + , ("total", JSON.toJSON True) + , ("limit", JSON.toJSON (20 :: Int)) + , ("csrf_token", JSON.toJSON csrf) + ] + body <- sendRequest session Post url request + validateJSON (decodeRecommend body) return + +fetchPlayLists :: (MonadIO m, MonadReader Session m) => m [(Int, String)] +fetchPlayLists = do + session@Session {..} <- ask + userId <- liftIO $ readIORef sessionUserId + if userId == 0 + then return [] + else do + body <- sendRequest session Get "http://music.163.com/api/user/playlist" (FetchPlayLists userId) + validateJSON (decodePlayLists body) return + +fetchPlayList :: (MonadIO m, MonadReader Session m) => Int -> m [Song.Song] +fetchPlayList id = do + session <- ask + body <- sendRequest session Get "http://music.163.com/api/playlist/detail" (FetchPlayList id) + validateJSON (decodePlayList body) return + +fetchUrl :: (MonadIO m, MonadReader Session m) => Song.Song -> m (Maybe String) +fetchUrl Song.Song {..} = do + session@Session {..} <- ask + csrf <- liftIO $ readIORef sessionCsrf + let url = "http://music.163.com/weapi/song/enhance/player/url?csrf_token=" ++ csrf + request <- encryptQuery $ encodeJSON $ JSON.object + [ ("ids", JSON.toJSON [uid]) + , ("br", JSON.toJSON (320000 :: Int)) + , ("csrf_token", JSON.toJSON csrf) + ] + body <- sendRequest session Post url request + case decodeUrl body of + Right [url] -> return (Just url) + _ -> return Nothing + +fetchLyrics :: (MonadIO m, MonadReader Session m) => Song.Song -> m Song.Lyrics +fetchLyrics Song.Song {..} = do + session <- ask + body <- sendRequest session Get "http://music.163.com/api/song/lyric" (FetchLyrics uid) + return $ either (const def) Song.parseLyrics (decodeLyrics body) diff --git a/lib/FM/NetEase/Crypto.hs b/lib/FM/NetEase/Crypto.hs new file mode 100644 --- /dev/null +++ b/lib/FM/NetEase/Crypto.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +module FM.NetEase.Crypto ( + toHex +, encryptAES +, encryptRSA +, encryptSongId +, encryptPassword +) where + +import qualified Crypto.Error as C +import qualified Crypto.Cipher.AES as C +import qualified Crypto.Cipher.Types as C +import qualified Crypto.Hash as C +import Data.Bits (xor) +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Base64 as Base64 +import Data.Char (chr, ord) +import Data.Maybe (fromJust) +import Numeric (showHex) + +toHex :: (Integral a, Show a) => a -> BS.ByteString +toHex n = BS8.pack (showHex n []) + +encryptAES :: BS.ByteString -> BS.ByteString -> BS.ByteString +encryptAES key text = encrypt key (encrypt ("0CoJUm6Qyw8W8jud" :: BS.ByteString) text) + where + encrypt key text = Base64.encode $ C.cbcEncrypt cipher iv plain + where + cipher = fromJust $ C.maybeCryptoError (C.cipherInit key) :: C.AES128 + plain = text `mappend` BS.replicate k (toEnum k) + where k = 16 - BS.length text `mod` 16 + iv = fromJust $ C.makeIV ("0102030405060708" :: BS.ByteString) + +encryptRSA :: BS.ByteString -> BS.ByteString +encryptRSA text = zfill 256 $ toHex $ (base^publicKey) `mod` modulo + where + zfill n xs = BS.replicate (n - BS.length xs) (toEnum $ ord '0') `mappend` xs + base = foldr ((\x y -> y * 256 + x) . toInteger) 0 (BS.unpack text) + publicKey = 65537 :: Integer + modulo = read $ concat [ "1577947502671315022124768178003" + , "4549812187278333338974742401153" + , "1025366277535262539913701806290" + , "7664791894775335978549896068031" + , "9425397866032994198078607243280" + , "6427833685472618792592200595694" + , "3468729513017705807651353492595" + , "9016749053613808246968063851441" + , "6594216629258349130257685001248" + , "172188325316586707301643237607" + ] :: Integer + +encryptSongId :: String -> String +encryptSongId id = flip map hashValue $ + \c -> case c of + '/' -> '_' + '+' -> '-' + c -> c + where + key = map ord "3go8&$8*3*3h0k(2)2" + bytes = zipWith xor (map ord id) (concat (repeat key)) + hashValue = BS8.unpack $ Base64.encode $ BS.pack $ BA.unpack $ C.hashWith C.MD5 $ BS8.pack $ map chr bytes + +encryptPassword :: String -> String +encryptPassword = show . C.hashWith C.MD5 . BS8.pack diff --git a/lib/FM/NetEase/JSON.hs b/lib/FM/NetEase/JSON.hs new file mode 100644 --- /dev/null +++ b/lib/FM/NetEase/JSON.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} + +module FM.NetEase.JSON ( + encodeJSON +, decodeFM +, decodeRecommend +, decodePlayList +, decodePlayLists +, decodeUrl +, decodeLyrics +, decodeUserId +) where + +import Control.Monad (forM) +import qualified Data.Aeson as JSON +import Data.Aeson ((.:)) +import Data.Aeson.Extra +import qualified Data.Aeson.Types as JSON +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Vector as V +import qualified Data.Text as T + +import qualified FM.Song as Song + +newtype FM = FM [Song.Song] +newtype Recommend = Recommend [Song.Song] +newtype PlayList = PlayList [Song.Song] + +instance JSON.FromJSON FM where + parseJSON = onObject $ \v -> FM <$> (v .: "data" >>= parseSongList) + +instance JSON.FromJSON Recommend where + parseJSON = onObject $ \v -> Recommend <$> (v .: "recommend" >>= parseSongList) + +instance JSON.FromJSON PlayList where + parseJSON = onObject $ \v -> PlayList <$> (v .: "result" >>= parse) + where parse = onObject $ \v -> v .: "tracks" >>= parseSongList + +parseSongList :: JSON.Value -> JSON.Parser [Song.Song] +parseSongList = onArray $ \v -> mapM parseSong (V.toList v) + +parseSong :: JSON.Value -> JSON.Parser Song.Song +parseSong = onObject $ \v -> do + let url = Nothing + title <- v .: "name" + uid <- v .: "id" + artists <- parseArtists =<< (v .: "artists") + album <- parseAlbum =<< (v .: "album") + return Song.Song {..} + +parseArtists :: JSON.Value -> JSON.Parser [String] +parseArtists = onArray $ \v -> forM (V.toList v) (onObject $ \v -> v .: "name") + +parseAlbum :: JSON.Value -> JSON.Parser String +parseAlbum = onObject $ \v -> v .: "name" + +decodeFM :: BS.ByteString -> Either String [Song.Song] +decodeFM bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (FM xs) = xs + +decodeRecommend :: BS.ByteString -> Either String [Song.Song] +decodeRecommend bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (Recommend xs) = xs + +decodePlayList :: BS.ByteString -> Either String [Song.Song] +decodePlayList bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (PlayList xs) = xs + +newtype PlayLists = PlayLists [(Int, String)] + +instance JSON.FromJSON PlayLists where + parseJSON = onObject $ \v -> PlayLists <$> (v .: "playlist" >>= parse) + where + parse = onArray $ \v -> mapM parsePlayLists (V.toList v) + where + parsePlayLists = onObject $ \v -> do + id <- v .: "id" + name <- v .: "name" + return (id, name) + +decodePlayLists :: BS.ByteString -> Either String [(Int, String)] +decodePlayLists bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (PlayLists xs) = xs + +newtype Url = Url [String] + +instance JSON.FromJSON Url where + parseJSON = onObject $ \v -> v .: "data" >>= parse + where parse = onArray $ \v -> Url <$> mapM parse2 (V.toList v) + parse2 = onObject $ \v -> v .: "url" + +decodeUrl :: BS.ByteString -> Either String [String] +decodeUrl bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (Url url) = url + +newtype Lyrics = Lyrics [String] + +instance JSON.FromJSON Lyrics where + parseJSON = onObject $ \v -> v .: "lrc" >>= parse + where parse = onObject $ \v -> Lyrics . lines . T.unpack <$> (v .: "lyric") + +decodeLyrics :: BS.ByteString -> Either String [String] +decodeLyrics bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (Lyrics lyrics) = lyrics + +newtype UserId = UserId Int + +instance JSON.FromJSON UserId where + parseJSON = onObject $ \v -> v .: "account" >>= parse + where parse = onObject $ \v -> UserId <$> (v .: "id") + +decodeUserId :: BS.ByteString -> Either String Int +decodeUserId bs = unwrap <$> JSON.eitherDecode (BL.fromStrict bs) + where unwrap (UserId id) = id diff --git a/lib/FM/Player.hs b/lib/FM/Player.hs new file mode 100644 --- /dev/null +++ b/lib/FM/Player.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE RecordWildCards, FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module FM.Player ( + MonadPlayer, runPlayer +, PlayerState (..) +, isStopped +, Player (..) +, initPlayer +, play +, pause +, resume +, stop +, updateVolume +) where + +import Control.Concurrent (ThreadId, forkFinally, killThread, myThreadId, throwTo) +import Control.Concurrent.Async (async, cancel, poll) +import Control.Concurrent.STM.Lock +import Control.Concurrent.STM.TMVar +import Control.Concurrent.STM.TVar +import Control.Exception (asyncExceptionFromException, AsyncException (..)) +import Control.Monad.IO.Class +import Control.Monad.Reader +import Control.Monad.STM (atomically) +import Data.Maybe (isJust, fromJust) +import System.IO +import System.Process (ProcessHandle, runInteractiveProcess, waitForProcess, terminateProcess) + +import qualified FM.Song as Song + +newtype MonadPlayer a = MonadPlayer (ReaderT Player IO a) + deriving (Functor, Applicative, Monad, MonadIO, MonadReader Player) + +runPlayer :: Player -> MonadPlayer a -> IO a +runPlayer player (MonadPlayer m) = runReaderT m player + +data PlayerState = Playing Song.Song + | Paused Song.Song + | Stopped + +isStopped :: PlayerState -> Bool +isStopped Stopped = True +isStopped _ = False + +data PlayerContext = PlayerContext { + inHandle :: Handle +, outHandle :: Handle +, errHandle :: Handle +, processHandle :: ProcessHandle +, parentThreadId :: ThreadId +, childThreadId :: ThreadId +} + +data Player = Player { + mpg123Context :: TMVar PlayerContext +, playerState :: TVar PlayerState +, playerVolume :: Int +, playerMuted :: Bool +, playerLock :: Lock +} + +initPlayer :: (MonadIO m) => m Player +initPlayer = liftIO $ do + mpg123Context <- newEmptyTMVarIO + playerState <- newTVarIO Stopped + let playerVolume = 100 + let playerMuted = False + playerLock <- newLockIO + return Player {..} + +type FetchUrl = Song.Song -> IO (Maybe String) +type FetchLyrics = Song.Song -> IO Song.Lyrics +type Notify a = a -> IO () + +play :: (MonadIO m, MonadReader Player m) => Song.Song -> FetchUrl -> FetchLyrics -> Notify () -> Notify Bool -> Notify (Double, Double) -> Notify String -> m () +play song@Song.Song {..} fetchUrl fetchLyrics onBegin onTerminate onProgress onLyrics = do + Player {..} <- ask + (inHandle, outHandle, errHandle, processHandle) <- liftIO $ runInteractiveProcess "mpg123" ["-R"] Nothing Nothing + let initHandle h = liftIO $ do + hSetBinaryMode h False + hSetBuffering h LineBuffering + initHandle inHandle + initHandle outHandle + lyricsAsync <- liftIO $ async $ fetchLyrics song + + let + notifyLyrics :: Song.Lyrics -> Double -> Notify String -> IO Song.Lyrics + notifyLyrics (Song.Lyrics lyrics) time notify = Song.Lyrics <$> + case span (\l -> fst l <= time) lyrics of + ([], restLyrics) -> return restLyrics + (curLyrics, restLyrics) -> do + notify $ snd (last curLyrics) + return restLyrics + + loop :: Bool -> (Double, Double, Maybe Song.Lyrics) -> String -> IO () + loop _ (len, cur, _) "@P 0" = onProgress (len, cur) + + loop True (0, 0, Nothing) "@P 2" = do + onBegin () + continue $ loop True (0, 0, Nothing) + + loop True _ out@('@':'F':_) = do + let len = read (words out !! 4) + onProgress (len, 0) + continue $ loop False (len, 0, Nothing) + + loop False (len, cur, lyrics) out@('@':'F':_) = do + let cur' = read (words out !! 3) + when (floor cur' /= floor cur) $ onProgress (len, cur') + lyrics' <- case lyrics of + Just lyrics -> Just <$> notifyLyrics lyrics cur' onLyrics + Nothing -> do + lyrics <- poll lyricsAsync + case lyrics of + Just (Right lyrics) -> Just <$> notifyLyrics lyrics cur' onLyrics + _ -> return Nothing + continue $ loop False (len, cur', lyrics') + + loop b ctx ('@':_) = continue $ loop b ctx + + loop _ _ _ = return () -- encounter mpg123 internal error. + + continue :: (String -> IO ()) -> IO () + continue cont = do + isEOF <- hIsEOF outHandle + unless isEOF $ cont =<< hGetLine outHandle + + playerThread = do + atomically $ waitLock playerLock Acquired + url <- fetchUrl song + when (isJust url) $ do + hPutStrLn inHandle $ "V " ++ show (if playerMuted then 0 else playerVolume) + hPutStrLn inHandle $ "L " ++ fromJust url + loop True (0, 0, Nothing) =<< hGetLine outHandle + + cleanUp e = do + PlayerContext {..} <- atomically $ do + writeTVar playerState Stopped + takeTMVar mpg123Context + cancel lyricsAsync + forM_ [inHandle, outHandle, errHandle] $ \h -> hClose h + terminateProcess processHandle + waitForProcess processHandle + case e of + Right _ -> onTerminate True + Left e -> case asyncExceptionFromException e of + Just ThreadKilled -> onTerminate False + _ -> throwTo parentThreadId e + atomically $ releaseLock playerLock + + parentThreadId <- liftIO myThreadId + childThreadId <- liftIO $ forkFinally playerThread cleanUp + void $ liftIO $ atomically $ do + putTMVar mpg123Context PlayerContext {..} + writeTVar playerState (Playing song) + acquireLock playerLock + +-- | pause, resume and stop are idempotent. +pause :: (MonadIO m, MonadReader Player m) => m () +pause = do + Player {..} <- ask + inHandle <- liftIO $ atomically $ do + state <- readTVar playerState + case state of + Playing s -> do + PlayerContext {..} <- readTMVar mpg123Context + writeTVar playerState (Paused s) + return $ Just inHandle + _ -> return Nothing + when (isJust inHandle) $ liftIO $ hPutStrLn (fromJust inHandle) "P" + +resume :: (MonadIO m, MonadReader Player m) => m () +resume = do + Player {..} <- ask + inHandle <- liftIO $ atomically $ do + state <- readTVar playerState + case state of + Paused s -> do + PlayerContext {..} <- readTMVar mpg123Context + writeTVar playerState (Playing s) + return $ Just inHandle + _ -> return Nothing + when (isJust inHandle) $ liftIO $ hPutStrLn (fromJust inHandle) "P" + +stop :: (MonadIO m, MonadReader Player m) => m () +stop = do + Player {..} <- ask + childThreadId <- liftIO $ atomically $ do + state <- readTVar playerState + case state of + Stopped -> return Nothing + _ -> do + PlayerContext {..} <- readTMVar mpg123Context + return $ Just childThreadId + when (isJust childThreadId) $ liftIO $ killThread (fromJust childThreadId) + liftIO $ atomically $ waitLock playerLock Released + +updateVolume :: (MonadIO m, MonadReader Player m) => m () +updateVolume = do + Player {..} <- ask + h <- fmap inHandle <$> liftIO (atomically $ tryReadTMVar mpg123Context) + let v = if playerMuted then 0 else playerVolume + liftIO $ maybe (return ()) (\h -> hPutStrLn h $ "V " ++ show v) h diff --git a/lib/FM/Session.hs b/lib/FM/Session.hs new file mode 100644 --- /dev/null +++ b/lib/FM/Session.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module FM.Session ( + MonadSession, runSession +, IsSession +, SomeSession (..) +, fromSession +) where + +import Control.Monad.Reader +import Data.Maybe (fromJust) +import Data.Typeable (Typeable, cast) + +newtype MonadSession s a = MonadSession (ReaderT s IO a) + deriving (Functor, Applicative, Monad, MonadIO, MonadReader s) + +runSession :: (IsSession s) => SomeSession -> MonadSession s a -> IO a +runSession session (MonadSession m) = runReaderT m (fromSession session) + +class Typeable s => IsSession s + +data SomeSession = forall s. (IsSession s, Typeable s) => SomeSession s + deriving (Typeable) + +fromSession :: (IsSession s, Typeable s) => SomeSession -> s +fromSession (SomeSession k) = fromJust $ cast k diff --git a/lib/FM/Song.hs b/lib/FM/Song.hs new file mode 100644 --- /dev/null +++ b/lib/FM/Song.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE RecordWildCards #-} + +module FM.Song ( + SongId +, Song (..) +, Lyrics (..) +, parseLyrics +) where + +import Data.Default.Class +import Data.List (sort, intercalate) +import Text.Parsec + +type SongId = Int + +data Song = Song { + uid :: SongId +, title :: String +, artists :: [String] +, album :: String +, url :: Maybe String +} + +newtype Lyrics = Lyrics [(Double, String)] + +instance Show Song where + show Song {..} = unlines [ "Song {" + , " uid = " ++ show uid ++ "," + , " title = " ++ title ++ "," + , " artists = " ++ dumpList artists ++ "," + , " album = " ++ album ++ "," + , " url = " ++ show url ++ "," + , "}" + ] + where + dumpList :: [String] -> String + dumpList [] = "(null)" + dumpList xs = intercalate " / " xs + +instance Show Lyrics where + show (Lyrics lyrics) = unlines [ "Lyrics {", unlines $ map (\(t, l) -> " [" ++ show t ++ "]" ++ l) lyrics, "}" ] + +instance Default Lyrics where + def = Lyrics [ (0, "No Lyrics") ] + +type Parser = Parsec String () + +parseLyrics :: [String] -> Lyrics +parseLyrics = Lyrics . sort . concatMap (either (const []) id . runParser parser () []) + where + number :: Parser Double + number = read <$> do + a <- many1 digit + b <- option [] $ try $ do + char '.' + ('.' :) <$> many1 digit + return (a ++ b) + + parser :: Parser [(Double, String)] + parser = do + times <- many1 $ between (char '[') (char ']') $ do + mm <- number + char ':' + ss <- number + return $ mm * 60 + ss + body <- manyTill anyToken eof + return $ zip times $ repeat body diff --git a/netease-fm.cabal b/netease-fm.cabal new file mode 100644 --- /dev/null +++ b/netease-fm.cabal @@ -0,0 +1,84 @@ +name: netease-fm +version: 1.2.2 +synopsis: NetEase Cloud Music FM client in Haskell. +description: NetEase Cloud Music FM client. +homepage: http://github.com/foreverbell/netease-fm#readme +license: BSD3 +license-file: LICENSE +author: foreverbell +maintainer: dql.foreverbell@gmail.com +copyright: 2016 foreverbell +category: Music, Web +build-type: Simple +cabal-version: >=1.10 +data-files: README.md + , LICENSE + +source-repository head + type: git + location: https://github.com/foreverbell/netease-fm + +library + hs-source-dirs: lib + default-language: Haskell2010 + ghc-options: -W -fwarn-tabs + build-depends: base >= 4.8 && < 5 + , random + , time + , exceptions + , process + , directory + , stm + , async + , data-default-class + , mtl + , transformers + , vector + , bytestring + , memory + , text + , parsec + , http-client + , http-client-tls + , http-types + , aeson + , base64-bytestring + , cryptonite + exposed-modules: + FM.Cache + FM.FM + FM.NetEase + FM.Song + other-modules: + Control.Concurrent.STM.Lock + Data.Aeson.Extra + FM.CacheManager + FM.NetEase.Crypto + FM.NetEase.JSON + FM.Player + FM.Session + +executable netease-fm + hs-source-dirs: exe + main-is: Main.hs + default-language: Haskell2010 + ghc-options: -dynamic -threaded -W -fwarn-tabs + build-depends: base + , transformers + , mtl + , directory + , process + , stm + , random + , containers + , data-default-class + , brick >= 0.6 && < 0.7 + , vty + , netease-fm + other-modules: + Types + UI.Black + UI.Extra + UI.Login + UI.Menu + UI.Player