From 9caa1f308685293a2a01e425fd81151b31e716cd Mon Sep 17 00:00:00 2001
From: wes <wjak56@gmail.com>
Date: Thu, 17 Sep 2015 21:10:08 -0400
Subject: [PATCH] updates

---
 Database.hs  |  6 +++---
 M3U.hs       | 43 +++++++++++++++++++++++++++++++++++++++++++
 Main.hs      | 10 +++++++---
 Playlists.hs | 21 +++++++++++++++++++++
 Types.hs     |  7 +++++++
 WebServer.hs | 22 ++++++++++++++++++++++
 6 files changed, 103 insertions(+), 6 deletions(-)
 create mode 100644 M3U.hs
 create mode 100644 Playlists.hs
 create mode 100644 WebServer.hs

diff --git a/Database.hs b/Database.hs
index 478e6aa..e3cc247 100644
--- a/Database.hs
+++ b/Database.hs
@@ -7,15 +7,14 @@ import Network.MPD.Core
 import Types
 import Search
 import qualified Unsafe.Coerce as C
-import qualified Data.Text as TIO
 import Data.Text.Encoding
-import System.Process
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString as B
 import Data.String.Utils
 import Data.Maybe
 import Control.Applicative
 import Utils
+import Playlists
 
 {-
  - unsafeCoerce is needed because the "Path"
@@ -63,8 +62,9 @@ addSingle :: SearchResult -> IO (Response [B.ByteString])
 addSingle track = do
   let trackUrl = url track
   let trackDesc = title track
-  fullUrl <- readProcess "youtube-dl" ["-g", "-f", "bestaudio", (TIO.unpack trackUrl)] ""
+  fullUrl <- getUrl trackUrl
   newId <- MP.withMPD $ MP.addId (toPath fullUrl) Nothing
+  --downUrl trackUrl
   either (const $ changeTitle trackDesc newId)
          (changeBoth newId)
          (parseTrack trackDesc)
diff --git a/M3U.hs b/M3U.hs
new file mode 100644
index 0000000..1b65ace
--- /dev/null
+++ b/M3U.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings #-}
+module M3U where
+
+import Types
+import qualified Data.Text as TIO
+import Data.Text.Encoding
+import Data.Maybe
+import Control.Applicative
+import Data.Monoid
+import Data.Attoparsec.Text
+import qualified Data.Attoparsec.Text as AT
+import Utils
+import Playlists
+import Search
+
+m3uHeader = "#EXTM3U"
+trackHeader = "#EXTINF"
+
+makeHeader title =
+  mconcat [trackHeader,
+          ":-1,",
+          title]
+
+--toExtinf :: SearchResult -> TIO.Text
+toExtinf track =
+  let trackTitle = title track
+      in case parseTrack trackTitle of
+        Right (artist, title) ->
+          makeHeader (artist `mappend` " - " `mappend` title `mappend` "\n")
+        Left trackname -> makeHeader $ TIO.pack (trackname `mappend` "\n")
+
+singleTrack track = do
+  let extinf = toExtinf track
+  trackUrl <- TIO.pack <$> (getUrl $ url track)
+  return $ extinf `mappend` trackUrl `mappend` "\n"
+
+genm3u :: [SearchResult] -> IO M3U
+genm3u srs = do
+  tracks <- mapM singleTrack srs
+  return $
+    M3U $ m3uHeader `mappend`
+    "\n" `mappend`
+    (mconcat tracks)
diff --git a/Main.hs b/Main.hs
index 072aa4d..a707358 100644
--- a/Main.hs
+++ b/Main.hs
@@ -6,14 +6,18 @@ import Types
 import Database
 import Data.List
 import System.Environment (getArgs)
-import qualified Data.Text.IO as TIO (putStrLn)
+import qualified Data.Text.IO as TIO (putStrLn, putStr)
 import qualified Control.Monad as M
+import M3U
 
 main = do
   args <- getArgs
   let mode = head args
   let searchTerm = intercalate " " $ tail args
   case mode of
-    "single" -> M.join (addSingle <$> firstResult searchTerm) >> return ()
-    "all" -> M.join (mapM_ addSingle <$> search searchTerm) >> return ()
+    --"single" -> M.join (addSingle <$> firstResult searchTerm) >> return ()
+    "all" -> do
+              m3ulist <- (M.join (genm3u <$> search searchTerm))
+              let (M3U filecontents) = m3ulist
+              TIO.putStr filecontents
     _ -> error "unknown mode"
diff --git a/Playlists.hs b/Playlists.hs
new file mode 100644
index 0000000..bd83e4d
--- /dev/null
+++ b/Playlists.hs
@@ -0,0 +1,21 @@
+module Playlists where
+
+import qualified Data.Text as TIO
+import System.Process (readProcess)
+import Utils
+
+getUrl :: TIO.Text -> IO String
+-- Gets a direct url using youtube-dl
+-- (if it is installed, otherwise we might fallback to some shitty code)
+
+getUrl yourl = readProcess "youtube-dl"
+                ["-g",
+                "-f",
+                "bestaudio",
+                TIO.unpack yourl,
+                "--no-cache-dir"] ""
+downUrl yourl = readProcess "youtube-dl"
+                  ["-f",
+                  "bestaudio",
+                  TIO.unpack yourl,
+                  "--no-cache-dir"] ""
diff --git a/Types.hs b/Types.hs
index 59792d3..03b7a8f 100644
--- a/Types.hs
+++ b/Types.hs
@@ -4,6 +4,7 @@ import Data.Aeson
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text as T
 import qualified Data.Map as M
+import qualified Data.String as S
 
 data URL = URL { jurl :: T.Text }
   deriving (Show, Eq)
@@ -38,6 +39,12 @@ data SearchResult = SearchResult {
 }
   deriving (Show, Eq)
 
+data M3U = M3U T.Text
+  deriving (Show)
+
+instance S.IsString M3U where
+  fromString = M3U . T.pack
+
 instance FromJSON URL where
   parseJSON (Object v) = URL <$> v .: "url"
   parseJSON _ = error "invalid parse"
diff --git a/WebServer.hs b/WebServer.hs
new file mode 100644
index 0000000..f0400a2
--- /dev/null
+++ b/WebServer.hs
@@ -0,0 +1,22 @@
+module WebServer where
+
+import Search
+import Network.MPD.Applicative.CurrentPlaylist
+import Types
+import Database
+import Data.List
+import System.Environment (getArgs)
+import qualified Data.Text.IO as TIO (putStrLn, putStr)
+import qualified Control.Monad as M
+import M3U
+
+getPlaylist args = do
+  let mode = head args
+  let searchTerm = intercalate " " $ tail args
+  case mode of
+    --"single" -> M.join (addSingle <$> firstResult searchTerm) >> return ()
+    "all" -> do
+              m3ulist <- (M.join (genm3u <$> search searchTerm))
+              let (M3U filecontents) = m3ulist
+              return filecontents
+    _ -> error "unknown mode"