netease-fm (empty) → 1.2.2
raw patch · 22 files changed
+1923/−0 lines, 22 filesdep +aesondep +asyncdep +basesetup-changed
Dependencies added: aeson, async, base, base64-bytestring, brick, bytestring, containers, cryptonite, data-default-class, directory, exceptions, http-client, http-client-tls, http-types, memory, mtl, netease-fm, parsec, process, random, stm, text, time, transformers, vector, vty
Files
- LICENSE +30/−0
- README.md +45/−0
- Setup.hs +3/−0
- exe/Main.hs +39/−0
- exe/Types.hs +53/−0
- exe/UI/Black.hs +45/−0
- exe/UI/Extra.hs +51/−0
- exe/UI/Login.hs +171/−0
- exe/UI/Menu.hs +90/−0
- exe/UI/Player.hs +299/−0
- lib/Control/Concurrent/STM/Lock.hs +46/−0
- lib/Data/Aeson/Extra.hs +25/−0
- lib/FM/Cache.hs +9/−0
- lib/FM/CacheManager.hs +192/−0
- lib/FM/FM.hs +22/−0
- lib/FM/NetEase.hs +239/−0
- lib/FM/NetEase/Crypto.hs +67/−0
- lib/FM/NetEase/JSON.hs +115/−0
- lib/FM/Player.hs +204/−0
- lib/FM/Session.hs +27/−0
- lib/FM/Song.hs +67/−0
- netease-fm.cabal +84/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -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+```++## 快捷键++<table>+ <tr> <td>Space / Enter</td> <td>确认 / 播放 / 暂停</td> </tr>+ <tr> <td>Esc</td> <td>停止 / 返回上一级菜单</td> </tr>+ <tr> <td>n</td> <td>播放下一首歌曲</td> </tr>+ <tr> <td>o</td> <td>播放模式选择</td> </tr>+ <tr> <td>c</td> <td>缓存选中歌曲</td> </tr>+ <tr> <td>C</td> <td>删除选中歌曲的缓存</td> </tr>+ <tr> <td>-</td> <td>减小音量</td> </tr>+ <tr> <td>=</td> <td>增大音量</td> </tr>+ <tr> <td>m</td> <td>静音 / 取消静音</td> </tr>+</table>
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ exe/Main.hs view
@@ -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
+ exe/Types.hs view
@@ -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
+ exe/UI/Black.hs view
@@ -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
+ exe/UI/Extra.hs view
@@ -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 " "
+ exe/UI/Login.hs view
@@ -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)
+ exe/UI/Menu.hs view
@@ -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
+ exe/UI/Player.hs view
@@ -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)
+ lib/Control/Concurrent/STM/Lock.hs view
@@ -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
+ lib/Data/Aeson/Extra.hs view
@@ -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"
+ lib/FM/Cache.hs view
@@ -0,0 +1,9 @@+module FM.Cache (+ initSession+, lookupCache+, fetchCache+, fetchUrl+, fetchLyrics+) where++import FM.CacheManager
+ lib/FM/CacheManager.hs view
@@ -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
+ lib/FM/FM.hs view
@@ -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
+ lib/FM/NetEase.hs view
@@ -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)
+ lib/FM/NetEase/Crypto.hs view
@@ -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
+ lib/FM/NetEase/JSON.hs view
@@ -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
+ lib/FM/Player.hs view
@@ -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
+ lib/FM/Session.hs view
@@ -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
+ lib/FM/Song.hs view
@@ -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
+ netease-fm.cabal view
@@ -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