myPlayer

-- pipe.hs
import System.Process
import System.Environment
main :: IO () 
a:_ <- getArgs
    (_, Just so, _, _)  <- createProcess (proc "runghc" ["randomList.hs",a]) { std_out = CreatePipe } 
    _ <- createProcess (proc "/home/i/myPlayer/viewer" []) { std_in = UseHandle so }
    return ()

-- randomList.hs
import System.Random
import System.Process
import System.Posix.Time (epochTime)
import System.Environment
import System.Directory
import System.FilePath.Posix
imnum = 10
lines' = return . lines
randomize :: [FilePath] -> IO [FilePath]
randomize lst = do
    let c = length lst
    r <- fromEnum <$> epochTime >>= (\x -> return (randomRs (0, (c-1)) (mkStdGen x) ))
    return [lst !! x|x <- take imnum r]
dirFilePairs :: [FilePath] -> IO [(FilePath,FilePath)]
dirFilePairs lst = return [(takeDirectory x,x) | x <- lst]
fileFilePairs :: [(FilePath,FilePath)] -> IO [(FilePath,FilePath)]
fileFilePairs = mapM (\(a,b) -> do{aa <- getAA a; return (aa,b)})
    where
        getAA p = do
            fs <- listDirectory p >>= filtFile ".jpg"
            if fs == [] then return "cd.jpg"
                        else return $ p ++ ['/'] ++ head(fs)
        filtFile ex = return . filter (\x -> takeExtension x == ex)
main = do
    fs <- getArgs >>= \(a:_) -> readFile a
    lines' fs >>= randomize >>= dirFilePairs >>= fileFilePairs >>= print
                                                                                                                      1,1          全て

-- viewer.hs
import Graphics.UI.Gtk
import System.Process
import MyButton
iSize = 100
getAps :: IO [(FilePath,FilePath)]
getAps = getContents >>= return . read
func1 f = createProcess (proc "audacious" [f]) >> return ()
main = do
    aps <- getAps
    initGUI
    w <-  windowNew
    set w [windowWindowPosition := WinPosNone,
            windowDefaultWidth := 400, windowDefaultHeight := 900]
    vb <- vBoxNew False 0
    sw <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport sw vb
    containerAdd w sw
    bs <- mapM (\(a,b) -> newImgButton iSize (a,b) func1) aps
    mapM (containerAdd vb) bs
    widgetShowAll w
    w `on` unrealize $ mainQuit
    mainGUI
~            
-- MyButton.hs
module MyButton where
import Graphics.UI.Gtk
newImgButton size (f,f') func = do
    p <- pixbufNewFromFileAtSize f size size
    i <- imageNewFromPixbuf p
    b <- buttonNew
    set b [buttonImage := i]
    l <- labelNew $ Just $ drop 12 f'
    set l [labelWrap := True]
    hb <- hBoxNew False 0
    containerAdd hb b
    containerAdd hb l
    b `on` buttonActivated $ func f'
    return hb