blob: 5df1a4da722f8dddba02a451d83aad292ce0c5b6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
{- querying quvi (import qualified)
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Utility.Quvi where
import Common
import Utility.Url
import Data.Aeson
import Data.ByteString.Lazy.UTF8 (fromString)
data Page = Page
{ pageTitle :: String
, pageLinks :: [Link]
} deriving (Show)
data Link = Link
{ linkSuffix :: String
, linkUrl :: URLString
} deriving (Show)
instance FromJSON Page where
parseJSON (Object v) = Page
<$> v .: "page_title"
<*> v .: "link"
parseJSON _ = mzero
instance FromJSON Link where
parseJSON (Object v) = Link
<$> v .: "file_suffix"
<*> v .: "url"
parseJSON _ = mzero
type Query a = [CommandParam] -> URLString -> IO a
{- Throws an error when quvi is not installed. -}
forceQuery :: Query (Maybe Page)
forceQuery ps url = query' ps url `catchNonAsync` onerr
where
onerr _ = ifM (inPath "quvi")
( error "quvi failed"
, error "quvi is not installed"
)
{- Returns Nothing if the page is not a video page, or quvi is not
- installed. -}
query :: Query (Maybe Page)
query ps url = flip catchNonAsync (const $ return Nothing) (query' ps url)
query' :: Query (Maybe Page)
query' ps url = decode . fromString
<$> readProcess "quvi" (toCommand $ ps ++ [Param url])
queryLinks :: Query [URLString]
queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url
{- Checks if quvi can still find a download link for an url.
- If quvi is not installed, returns False. -}
check :: Query Bool
check ps url = maybe False (not . null . pageLinks) <$> query ps url
{- Checks if an url is supported by quvi, without hitting it, or outputting
- anything. Also returns False if quvi is not installed. -}
supported :: URLString -> IO Bool
supported url = boolSystem "quvi" [Params "-v mute --support", Param url]
quiet :: CommandParam
quiet = Params "-v quiet"
noredir :: CommandParam
noredir = Params "-e -resolve"
{- Only return http results, not streaming protocols. -}
httponly :: CommandParam
httponly = Params "-c http"
|
