Hmpf-0.1: src/Main.hs

module Main where


import qualified Hmpf.Monitor as M
import Hmpf.ApplicationTypes
import Hmpf.LCDProc
import Hmpf.Control
import Hmpf.Tree
import Hmpf.MPDSession
import Hmpf.LIRC 
import Hmpf.Keys
import Hmpf.AudioScrobbler
import Hmpf.Util (pick)
import Hmpf.RelatedArtist
import Hmpf.Config
-----------------
import Control.Concurrent.MVar
import Control.Concurrent
import Data.List -- ( elemIndex )
import Data.Char ( toLower )
import Data.Time
import System.IO
import Control.Exception ( finally )
import qualified Control.Monad.State as S


main :: IO ()
main = do
 hSetBuffering stdin NoBuffering
 hSetBuffering stdout NoBuffering
 runSession programme

programme = do
 load ""
 Hmpf.LIRC.clear
 sm <- lower songMonitor
 scrm <- lower scrobblermonitor
 gen <- lower generation
 lc <- lower loadCache
 lift ( forkIO lc ) -- start thread to load cache
 lift ( forkIO (finally sm (putStrLn "Song monitor has failed"))) -- start thread to update play screen
 lift ( forkIO scrm ) -- start thread to send songs to Last.fm
 lift ( forkIO gen ) -- start thread to add auto-generated songs
 input


input :: Session ()
input = do
 showMusic
 k <- lirc
 case k of 
  TaskSwitcher -> randomAlbum
  Eject -> do
            b <- toggleAutogeneration 
	    let sw = ( toEnum . fromEnum $ b ) :: Switch
	    alert "Auto-generated" ( "playlist :" ++ (show sw) )
  Play -> play>>return()
  Stop -> stop>>return()
  Pause -> pause>>return()
  Timer -> sleep
  NextChapter -> nextSong >> return()
  PrevChapter -> previousSong >> return()
  FastForward -> fastforward >> return()
  Rewind -> rewind >> return()
  VolUp -> vol 10 >>= percent "Vol" >> return()
  VolDown -> vol (-10) >>= percent "Vol" >> return()
  Purple -> updatedb >> alert "Updating the" "music database"
  Enter -> selectFromPlaylist >> return ()
  Red -> do 
          alb <- selectAlbumByTrack
	  case alb of
	   Nothing-> return ()
	   Just alb' -> playAlbum alb'
  AppLauncher -> do
                  alb <- selectAlbum
		  case alb of
		   Nothing -> return ()
		   Just alb' -> playAlbum alb'
  MultiMon -> do
               a <- selectArtist -- choose the artist
	       case a of 
	        Nothing -> return ()
		Just a' -> do 
		  alb <- selectAlbumByArtist a' -- choose the album
		  maybe (return ()) playAlbum alb -- play the album
  _ -> return ()
 input

runSession :: Session a -> IO a
runSession fn = do
 mv <- empty
 S.runStateT ( initialize >> M.initialize >> fn >>= closeSession ) mv >>= ( return . fst )

--Select an artist
selectArtist :: Session (Maybe String)
selectArtist = do
 as <- artists
 let ls = map (map toLower) $ as
 l <- selector ls
 -- Use the Maybe monad here just to be funky
 return ( do
           x <- l
	   i <- elemIndex x ls
	   return ( as !! i )
	)

--Select an album
selectAlbum :: Session (Maybe String)
selectAlbum = do
 as <- albums
 let ls = map (map toLower) $ as
 l <- selector ls
 -- Use the Maybe monad here just to be funky
 return ( do
           x <- l
	   i <- elemIndex x ls
	   return ( as !! i )
	)

--Select an album by artist
selectAlbumByArtist :: String -> Session (Maybe String)
selectAlbumByArtist artist = do
 as <- albumByArtist artist
 let ls = map (map toLower) $ as
 l <- selector ls
 -- Use the Maybe monad here just to be funky
 return ( do
           x <- l
	   i <- elemIndex x ls
	   return ( as !! i )
	)


--Select an album by track
selectAlbumByTrack:: Session (Maybe String)
selectAlbumByTrack = do
 ts <- getTracks
 let ls = map (map toLower) $ ts
 l <- selector ls
 let l' =        ( do
                    x <- l
	            i <- elemIndex x ls
	            return ( ts !! i )
	         )
 case l' of 
  Nothing -> return Nothing
  Just l'' -> do
               albs <- ( Hmpf.MPDSession.albumByTrack l'')
               case albs of
                [] -> return Nothing
                (x:xs) -> return (Just x)


randomAlbum :: Session ()
randomAlbum = do
 alb <- albums >>= (lift . pick)
 playAlbum alb
 Just sng <- currentsong
 alert alb (artist sng)
 lift (putStr $ (artist sng) ++ " -- ")
 lift (putStrLn alb)
 return ()


selectFromPlaylist :: Session ()
selectFromPlaylist = do
 sngs <- playlistinfo
 st <- status
 let ns = map (\(i,t) -> (show i) ++ ". " ++ t ) . zip [1..] . map title $ sngs
     c = case ( song st ) of 
          Nothing -> 0
	  Just i -> i
     xs = (drop c ns) ++ ( take c ns)
 r <- selectByList xs
 case r  of 
  Nothing -> return ()
  Just i' -> (command ( "play " ++ (show $ i' + c ) ) >> return () )




getTracks :: Session [String] 
getTracks = do
 ts <- tracks
 lift ( putStrLn . show . length $ ts)
 let ts' = filter badchars $ ts
 lift ( putStrLn . show . length $ ts')
 return ts'
 where
  badchars = foldr (\c -> \b -> (fromEnum c > 35) && b ) True


sleep :: Session ()
sleep = do
 st <- get
 let t = (timer st + 10) `mod` 70
 put (st { timer = t })
 M.unscheduleAction "sleep"
 if t > 0 
  then    M.scheduleAction "sleep" 
                           ( t * 60 ) 
			   (do command "stop" 
			       st' <- get
			       put st' { timer = 0 } ) >> alert "Timer set" ( (show t) ++ " min" )
  else alert "Timer off" ""