Add Players, cabalify

LICENSE

@@ -0,0 +1,7 @@
+Copyright (C) 2012 Dmitry Malikov
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Loh.cabal

@@ -0,0 +1,41 @@
+Name:                   Loh
+Version:                0.0.0
+Category:               Network
+Description:            LastFMScrobbler on Haskell
+Synopsis:               LastFMScrobbler on Haskell
+
+License:                MIT
+License-file:           LICENSE
+
+Author:                 Dmitry Malikov
+
+Maintainer:             Dmitry Malikov <[email protected]>
+
+Build-type:             Simple
+Cabal-version:          >= 1.6
+Homepage:               -
+
+Library
+  Build-Depends:        base >= 3 && < 5,
+                        containers,
+                        directory,
+                        filepath,
+                        libmpd == 0.7.2,
+                        liblastfm,
+                        mtl,
+                        old-locale,
+                        process,
+                        split,
+                        time,
+                        transformers
+
+
+  HS-Source-Dirs:       src, src/Mocp
+
+  Exposed-Modules:      Loh.Types,
+                        Loh.DB,
+                        Loh.Player,
+                        Loh.Scrobbler
+                        Mocp
+
+  GHC-Options:          -Wall

src/Loh.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE UnicodeSyntax #-}
+module Loh where
+
+import Control.Applicative ((<$>), (<*>))
+import Data.Char (isSpace)
+import Data.List.Split (splitOn)
+import Data.Maybe
+import System.Directory (getHomeDirectory)
+import System.FilePath ((</>))
+
+import qualified Network.Lastfm as LFM
+
+configFilePath ∷ FilePath
+configFilePath = ".lastfm.conf"
+
+getConfig ∷ IO (LFM.APIKey, LFM.SessionKey, LFM.Secret)
+getConfig = do
+  configContent ← readFile <$> (</> configFilePath) <$> getHomeDirectory
+  values ← map ((\[x,y] -> (x,y)) . splitOn "=" . filter (not . isSpace)) . lines <$> configContent
+  return $ fromMaybe (error "Config at ~/.lastfm.conf should contain APIKey, SessionKey and Secret") (readConfig values)
+  where
+    readConfig xs = (,,) <$> (LFM.APIKey <$> lookup "APIKey" xs) <*> (LFM.SessionKey <$> lookup "SessionKey" xs) <*> (LFM.Secret <$> lookup "Secret" xs)
+
+
+main ∷ IO ()
+main = 

Loh/DB.hs → src/Loh/DB.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE UnicodeSyntax #-}
 module Loh.DB
   ( clear
   , getDB

src/Loh/Player.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE UnicodeSyntax #-}
+module Loh.Player where
+
+import Control.Applicative ((<$>))
+import Data.Maybe (fromJust, fromMaybe, isJust)
+
+import Loh.Types
+
+import qualified Data.Map as M
+import qualified Mocp as MOC
+import qualified Network.MPD as MPD
+
+getMocpInfo ∷ IO (Maybe TrackInfo)
+getMocpInfo = do
+  mocpResponse ← MOC.mocp
+  return $ case mocpResponse of
+    Right (MOC.MocpInfo MOC.Playing (Just s)) → Just TrackInfo
+      { artist = MOC.artist $ MOC.metadata s
+      , album = MOC.album $ MOC.metadata s
+      , duration = (fromIntegral (MOC.currentSec s)) / (fromIntegral (MOC.totalSec s))
+      , track = MOC.track $ MOC.metadata s
+      }
+    _ → Nothing
+
+getMpdInfo ∷ IO (Maybe TrackInfo)
+getMpdInfo = do
+  maybeSong ← MPD.withMPD MPD.currentSong
+  status ← MPD.withMPD MPD.status
+  return $ case status of
+    Right _ → case MPD.stState <$> status of
+      Right MPD.Playing → case maybeSong of
+        Right (Just song) → case MPD.stTime <$> status of
+          Right (curTime, totalTime) →
+            Just TrackInfo
+              { artist = fromMaybe "No Artist" $ head <$> M.lookup MPD.Artist tag
+              , album = fromMaybe "No Album" $ head <$> M.lookup MPD.Album tag
+              , duration = curTime / (fromIntegral totalTime)
+              , track = fromMaybe "No Track" $ head <$> M.lookup MPD.Track tag
+              } where tag = MPD.sgTags song
+          _ → Nothing
+        _ → Nothing
+      _ → Nothing
+    _ → Nothing
+
+getPlayersInfo ∷ IO PlayersInfo
+getPlayersInfo = do
+  maybeMpdInfo ← getMpdInfo
+  maybeMocpInfo ← getMocpInfo
+  return . M.fromList . catMaybeSnd $
+    [ (Mpd, maybeMpdInfo)
+    , (Mocp, maybeMocpInfo)
+    ]
+    where catMaybeSnd = map (\(f,s) -> (f, fromJust s)) . filter (isJust . snd)

Loh/Scrobbler.hs → src/Loh/Scrobbler.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE UnicodeSyntax #-}
 module Loh.Scrobbler
   ( nowPlaying, scrobbleDB, scrobbleTrack
   ) where
@@ -9,7 +10,7 @@ import Data.Time (formatTime, getCurrentTime)
 import System.Locale (defaultTimeLocale)
 
 import qualified Network.Lastfm as LFM
-import qualified Network.Lastfm.API.Track as Track
+import qualified Network.Lastfm.XML.Track as Track
 
 import Loh.DB (getDB)
 import Loh.Types
@@ -24,14 +25,14 @@ nowPlaying (ak, sk, s) ti =
                            Nothing
                            Nothing
                            Nothing
-                           (Just $ LFM.Duration $ duration ti)
+                           Nothing
                            ak sk s
 
 scrobbleTrack ∷ (LFM.APIKey, LFM.SessionKey, LFM.Secret) → TrackInfo → IO ()
 scrobbleTrack (ak, sk, s) ti = do
     nts ← read . formatTime defaultTimeLocale "%s" <$> getCurrentTime
     void $ left (error . show) <$>
-        Track.scrobble (LFM.Timestamp nts
+        Track.scrobble ( LFM.Timestamp nts
                        , Just $ LFM.Album $ album ti
                        , LFM.Artist $ artist ti
                        , LFM.Track $ track ti
@@ -49,7 +50,7 @@ scrobbleDB (ak, sk, s) = do
   db ← getDB
   forM_ db $ \(DBRecord (Timestamp ts) ti) →
     void $ left (error . show) <$>
-        Track.scrobble (LFM.Timestamp ts
+        Track.scrobble ( LFM.Timestamp ts
                        , Just $ LFM.Album $ album ti
                        , LFM.Artist $ artist ti
                        , LFM.Track $ track ti

Loh/Types.hs → src/Loh/Types.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Loh.Types where
 
-module Loh.Types
-  ( DBRecord(..), DBSize(..), Timestamp(..), TrackInfo(..)
-  ) where
+import qualified Data.Map as M
 
 newtype Timestamp = Timestamp Integer
   deriving (Read, Show)
@@ -13,9 +13,14 @@ newtype DBSize = DBSize Int
 data TrackInfo = TrackInfo
   { artist    ∷ String
   , album     ∷ String
-  , duration  ∷ Int
+  , duration  ∷ Double
   , track     ∷ String
   } deriving (Read, Show)
 
 data DBRecord = DBRecord Timestamp TrackInfo
   deriving (Read, Show)
+
+data PlayerName = Mocp | Mpd
+  deriving (Eq, Ord, Read, Show)
+
+type PlayersInfo = M.Map PlayerName TrackInfo

Mocp/Mocp.hs → src/Mocp/Mocp.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE UnicodeSyntax #-}
 
 module Mocp
   ( mocp
+  , Metadata(..), MocpInfo(..), MocpState(..), Song(..)
   ) where
 
 import Control.Applicative ((<$>))
@@ -13,20 +15,60 @@ import Data.List.Split (splitOn)
 import GHC.IO.Exception (ExitCode(..))
 import System.Process (readProcessWithExitCode)
 
-import Types
+type MocpResponse = Either MocpError
 
-getValue ∷ String → MocpResponse → String
+type MocpError = String
+
+data MocpState = Paused | Playing | Stopped
+  deriving (Eq, Show)
+
+type Album  = String
+type Artist = String
+type File   = String
+type Title  = String
+type Track  = String
+
+data Metadata = Metadata
+  { album  ∷ Album
+  , artist ∷ Artist
+  , file   ∷ File
+  , title  ∷ Title
+  , track  ∷ Track
+  } deriving Show
+
+type CurrentSec = Int
+type TotalSec   = Int
+
+data Song = Song
+  { metadata   ∷ Metadata
+  , currentSec ∷ CurrentSec
+  , totalSec   ∷ TotalSec
+  } deriving Show
+
+data MocpInfo = MocpInfo MocpState (Maybe Song)
+  deriving Show
+
+mocp ∷ IO (MocpResponse MocpInfo)
+mocp = (>>= getStatus) <$> runErrorT callMocp
+
+callMocp ∷ ErrorT MocpError IO String
+callMocp = do
+  (exitCode, !response, errorMessage) ← liftIO $ readProcessWithExitCode "mocp" ["-i"] ""
+  when (exitCode /= ExitSuccess) $ throwError errorMessage
+  return response
+
+getValue ∷ String → String → String
 getValue p = (!! 1) . splitOn ": " . head . filter (isPrefixOf p) . lines
 
-getState ∷ MocpResponse → Maybe State
+getState ∷ String → Maybe MocpState
 getState r =
   case getValue "State" r of
     "PAUSE" → Just Paused
     "PLAY"  → Just Playing
     "STOP"  → Just Stopped
     _       → Nothing
 
-getSong ∷ MocpResponse → Maybe Song
+getSong ∷ String → Maybe Song
 getSong r =
   case getState r of
     Nothing      → Nothing
@@ -44,18 +86,9 @@ getSong r =
         , totalSec   = read $ getValue "TotalSec" r
       }
 
-getStatus ∷ MocpResponse → MocpStatus
+getStatus ∷ String → MocpResponse MocpInfo
 getStatus r =
   case getState r of
     Nothing      → Left "Mocp server is not running"
     Just Stopped → Right $ MocpInfo Stopped Nothing
     Just s       → Right $ MocpInfo s $ getSong r
-
-mocp ∷ IO MocpStatus
-mocp = (>>= getStatus) <$> runErrorT callMocp
-
-callMocp ∷ ErrorT MocpError IO MocpResponse
-callMocp = do
-  (exitCode, !response, errorMessage) ← liftIO $ readProcessWithExitCode "mocp" ["-i"] ""
-  when (exitCode /= ExitSuccess) $ throwError errorMessage
-  return response