Adding ytsearch

1 files changed, 34 insertions, 8 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 593d243..82acb3c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -11,9 +11,10 @@ import           Control.Lens                   ( (^.)
                                                 , (^?)
                                                 )
 import           Control.Monad.IO.Class         ( liftIO )
-import           Data.Aeson                     ( FromJSON
+import           Data.Aeson                     ( (.:)
+                                                , FromJSON(..)
                                                 , ToJSON
-                                                , Value
+                                                , Value(..)
                                                 , decode
                                                 , encode
                                                 )
@@ -25,13 +26,16 @@ import           Data.Aeson.Lens                ( AsNumber(..)
                                                 , AsValue(..)
                                                 , key
                                                 )
-import qualified Data.ByteString.Lazy          as BSL
+import qualified Data.ByteString               as BS
+import qualified Data.ByteString.Lazy.Char8    as BSL
 import           Data.Either                    ( fromRight )
 import qualified Data.HashMap.Lazy             as HM
 import           Data.List                      ( find
                                                 , isSuffixOf
                                                 )
-import           Data.Maybe                     ( fromJust )
+import           Data.Maybe                     ( catMaybes
+                                                , fromJust
+                                                )
 import           Data.Proxy                     ( Proxy(..) )
 import qualified Data.Text                     as T
 import           Data.Text                      ( Text )
@@ -116,7 +120,7 @@ type GetInfobox
   = "wikipedia" :> "infobox" :> Capture "name" Text :> Get '[JSON] (HM.HashMap Text Text)
 
 type YtSearch
-  = "ytdl" :> "search" :> Capture "query" Text :> Get '[PlainText] Text
+  = "ytdl" :> "search" :> Capture "query" Text :> Get '[JSON] [Video]
 
 server :: Server API
 server =
@@ -173,13 +177,35 @@ getInfobox name = do
           (fromRight [] (parseWikiTemplates wiki))
     )
 
-searchYt :: Text -> Handler Text
+searchYt :: Text -> Handler [Video]
 searchYt query = do
   (_, Just hout, _, _) <- liftIO $ createProcess
-    (proc "yt-dlp" ["-j", "ytsearch5:" <> T.unpack query])
+    (proc "yt-dlp" ["-j", "ytsearch3:" <> T.unpack query])
       { std_out = CreatePipe
       }
-  liftIO $ hGetContents hout
+  liftIO $ (catMaybes . map decode . BSL.lines) <$> BSL.hGetContents hout
+
+data Video = Video
+  { vid       :: Text
+  , vtitle    :: Text
+  , vdesc     :: Text
+  , vduration :: Int
+  }
+  deriving (Eq, Show, Generic)
+
+instance FromJSON Video where
+  parseJSON (Object o) =
+    Video
+      <$> o
+      .:  "id"
+      <*> o
+      .:  "title"
+      <*> o
+      .:  "description"
+      <*> o
+      .:  "duration"
+
+instance ToJSON Video
 
 app :: Application
 app = serve api server