initial version of ytdl search

2 files changed, 23 insertions, 3 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 7e96dc8..593d243 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -36,6 +36,7 @@ import           Data.Proxy                     ( Proxy(..) )
 import qualified Data.Text                     as T
 import           Data.Text                      ( Text )
 import qualified Data.Text.Encoding            as TE
+import           Data.Text.IO                   ( hGetContents )
 import           GHC.Generics                   ( Generic )
 import           Network.Wai.Handler.Warp       ( run )
 import           Network.Wreq                   ( Response
@@ -73,6 +74,11 @@ import           Servant                        ( (:<|>)(..)
                                                 , Server
                                                 , serve
                                                 )
+import           System.Process                 ( CreateProcess(..)
+                                                , StdStream(..)
+                                                , createProcess
+                                                , proc
+                                                )
 import           Text.Pandoc                    ( WrapOption(..)
                                                 , WriterOptions(..)
                                                 , def
@@ -83,11 +89,13 @@ import           Text.Pandoc                    ( WrapOption(..)
                                                 )
 import           Text.Regex.TDFA                ( (=~) )
 
-type API = Wikipedia
+type API = Wikipedia :<|> Ytdl
 
 type Wikipedia
   = SearchWikipedia :<|> GetWikiFormat :<|> GetOrgFormat :<|> GetPandocFormat :<|> GetWpSummary :<|> GetInfobox
 
+type Ytdl = YtSearch
+
 -- TODO: fix the problem with plaintext having the wront content-type: text/plain
 type SearchWikipedia
   = "wikipedia" :> "search" :> Capture "query" Text :> Get '[PlainText] Text
@@ -107,14 +115,19 @@ type GetWpSummary
 type GetInfobox
   = "wikipedia" :> "infobox" :> Capture "name" Text :> Get '[JSON] (HM.HashMap Text Text)
 
+type YtSearch
+  = "ytdl" :> "search" :> Capture "query" Text :> Get '[PlainText] Text
+
 server :: Server API
 server =
-  searchWikipedia
+  (    searchWikipedia
     :<|> getWikiFormat
     :<|> getOrgFormat
     :<|> getPandocFormat
     :<|> getWpSummary
     :<|> getInfobox
+    )
+    :<|> searchYt
 
 searchWikipedia :: Text -> Handler Text
 searchWikipedia query = do
@@ -160,6 +173,13 @@ getInfobox name = do
           (fromRight [] (parseWikiTemplates wiki))
     )
 
+searchYt :: Text -> Handler Text
+searchYt query = do
+  (_, Just hout, _, _) <- liftIO $ createProcess
+    (proc "yt-dlp" ["-j", "ytsearch5:" <> T.unpack query])
+      { std_out = CreatePipe
+      }
+  liftIO $ hGetContents hout
 
 app :: Application
 app = serve api server
diff --git a/servall.cabal b/servall.cabal
index 6e44e50..05e1b2a 100644
--- a/servall.cabal
+++ b/servall.cabal
@@ -37,7 +37,7 @@ executable servall
     -- other-extensions:
     build-depends:    aeson, attoparsec, base, bytestring
                     , lens, lens-aeson, optparse-applicative
-                    , pandoc, regex-tdfa
+                    , pandoc, process, regex-tdfa
                     , servant, servant-server
                     , text, unordered-containers, warp, wreq
     hs-source-dirs:   app, src