Browse Source

Initial import

tags/v0.1.0.0^0
Peter J. Jones 2 years ago
commit
9f39783cb9
Signed by: Peter Jones <pjones@devalot.com> GPG Key ID: 9DAFAA8D01941E49
12 changed files with 450 additions and 0 deletions
  1. 3
    0
      .gitignore
  2. 1
    0
      AUTHORS
  3. 3
    0
      CHANGES.md
  4. 30
    0
      LICENSE
  5. 16
    0
      README.md
  6. 2
    0
      Setup.hs
  7. 2
    0
      cabal.project
  8. 46
    0
      examples/example.hs
  9. 77
    0
      playlists-http.cabal
  10. 209
    0
      src/Text/Playlist/HTTP/Full.hs
  11. 51
    0
      src/Text/Playlist/HTTP/Simple.hs
  12. 10
    0
      stack.yaml

+ 3
- 0
.gitignore View File

@@ -0,0 +1,3 @@
1
+/.stack-work
2
+/cabal.project.local
3
+/dist-newstyle

+ 1
- 0
AUTHORS View File

@@ -0,0 +1 @@
1
+Peter Jones <pjones@devalot.com> (Maintainer)

+ 3
- 0
CHANGES.md View File

@@ -0,0 +1,3 @@
1
+# Version 0.1.0.0 (November 21, 2016)
2
+
3
+  * Initial release.

+ 30
- 0
LICENSE View File

@@ -0,0 +1,30 @@
1
+Copyright (c) 2016 Peter Jones <pjones@devalot.com>
2
+
3
+All rights reserved.
4
+
5
+Redistribution and use in source and binary forms, with or without
6
+modification, are permitted provided that the following conditions are met:
7
+
8
+    * Redistributions of source code must retain the above copyright
9
+      notice, this list of conditions and the following disclaimer.
10
+
11
+    * Redistributions in binary form must reproduce the above
12
+      copyright notice, this list of conditions and the following
13
+      disclaimer in the documentation and/or other materials provided
14
+      with the distribution.
15
+
16
+    * Neither the name of Peter Jones nor the names of other
17
+      contributors may be used to endorse or promote products derived
18
+      from this software without specific prior written permission.
19
+
20
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ 16
- 0
README.md View File

@@ -0,0 +1,16 @@
1
+# playlists-http
2
+
3
+Download and parse playlists over HTTP.
4
+
5
+## Usage
6
+
7
+There are two interfaces, a simple `download` function that runs in
8
+`IO` and a more complicated `download` function that uses `MonadIO`.
9
+
10
+See the following modules for more details:
11
+
12
+  * `Text.Playlist.HTTP.Simple`
13
+  * `Text.Playlist.HTTP.Full`
14
+
15
+There is also an `examples/example.hs` that demonstrates how to use
16
+the `download` function which is found in `Text.Playlist.HTTP.Full`.

+ 2
- 0
Setup.hs View File

@@ -0,0 +1,2 @@
1
+import Distribution.Simple
2
+main = defaultMain

+ 2
- 0
cabal.project View File

@@ -0,0 +1,2 @@
1
+packages: ./
2
+          ../playlists

+ 46
- 0
examples/example.hs View File

@@ -0,0 +1,46 @@
1
+{-
2
+
3
+This file is part of the Haskell package playlists-http. It is subject to
4
+the license terms in the LICENSE file found in the top-level directory
5
+of this distribution and at git://pmade.com/playlists-http/LICENSE. No part
6
+of playlists-http package, including this file, may be copied, modified,
7
+propagated, or distributed except according to the terms contained in
8
+the LICENSE file.
9
+
10
+-}
11
+
12
+--------------------------------------------------------------------------------
13
+module Main (main) where
14
+
15
+--------------------------------------------------------------------------------
16
+import Text.Playlist.HTTP.Full
17
+
18
+--------------------------------------------------------------------------------
19
+import Control.Monad (when)
20
+import qualified Data.Text as Text
21
+import Network.HTTP.Client (newManager, defaultManagerSettings, Manager)
22
+import System.Environment (getArgs)
23
+
24
+--------------------------------------------------------------------------------
25
+-- | Main!
26
+main :: IO ()
27
+main = do
28
+    args <- getArgs
29
+    when (null args) $ fail "Usage: example URL"
30
+
31
+    -- For a TLS connection, use the @http-client-tls@ package!
32
+    manager <- newManager defaultManagerSettings
33
+    result  <- download (env manager) (Text.pack $ head args)
34
+
35
+    case result of
36
+      Left err -> fail (show err)
37
+      Right pl -> print pl
38
+
39
+  where
40
+    -- | Create an @Environment@.
41
+    env :: Manager -> Environment
42
+    env m = Environment m limit
43
+
44
+    -- | No download limit.
45
+    limit :: Int -> ByteStatus
46
+    limit _ = Continue

+ 77
- 0
playlists-http.cabal View File

@@ -0,0 +1,77 @@
1
+name:          playlists-http
2
+version:       0.1.0.0
3
+synopsis:      Library to glue together playlists and http-client
4
+homepage:      https://github.com/pjones/playlists-http
5
+license:       BSD3
6
+license-file:  LICENSE
7
+author:        Peter Jones <pjones@devalot.com>
8
+maintainer:    Peter Jones <pjones@devalot.com>
9
+copyright:     Copyright (c) 2016 Peter Jones
10
+category:      Text
11
+build-type:    Simple
12
+cabal-version: >= 1.18
13
+description:   Simple library for resolving playlists using http-client.
14
+
15
+--------------------------------------------------------------------------------
16
+extra-source-files:
17
+  AUTHORS
18
+  README.md
19
+  CHANGES.md
20
+
21
+--------------------------------------------------------------------------------
22
+source-repository head
23
+  type:     git
24
+  location: https://github.com/pjones/playlists-http.git
25
+
26
+--------------------------------------------------------------------------------
27
+flag maintainer
28
+  description: Enable settings for the package maintainer.
29
+  default: False
30
+  manual: True
31
+
32
+--------------------------------------------------------------------------------
33
+flag build-examples
34
+  description: Build the example programs.
35
+  default: False
36
+  manual: True
37
+
38
+--------------------------------------------------------------------------------
39
+library
40
+  exposed-modules:
41
+    Text.Playlist.HTTP.Simple
42
+    Text.Playlist.HTTP.Full
43
+
44
+  default-language: Haskell2010
45
+  hs-source-dirs: src
46
+  ghc-options: -Wall
47
+
48
+  if flag(maintainer)
49
+    ghc-options: -Werror
50
+
51
+  build-depends: attoparsec   >= 0.10  && < 1.0
52
+               , base         >= 4.6   && < 5
53
+               , bytestring   >= 0.10  && < 1.0
54
+               , either       >= 4.4   && < 4.5
55
+               , exceptions   >= 0.8   && < 0.9
56
+               , http-client  >= 0.4   && < 0.6
57
+               , mtl          >= 2.2   && < 2.3
58
+               , playlists    >= 0.4   && < 0.5
59
+               , text         >= 0.11  && < 1.3
60
+
61
+--------------------------------------------------------------------------------
62
+executable example
63
+  default-language: Haskell2010
64
+  hs-source-dirs: examples
65
+  main-is: example.hs
66
+  ghc-options: -Wall
67
+
68
+  if flag(maintainer)
69
+    ghc-options: -Werror
70
+
71
+  if !flag(build-examples)
72
+    buildable: False
73
+  else
74
+    build-depends: base
75
+                 , http-client
76
+                 , playlists-http
77
+                 , text

+ 209
- 0
src/Text/Playlist/HTTP/Full.hs View File

@@ -0,0 +1,209 @@
1
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2
+{-# LANGUAGE ScopedTypeVariables        #-}
3
+
4
+{-
5
+
6
+This file is part of the Haskell package playlists-http. It is subject to
7
+the license terms in the LICENSE file found in the top-level directory
8
+of this distribution and at git://pmade.com/playlists-http/LICENSE. No part
9
+of playlists-http package, including this file, may be copied, modified,
10
+propagated, or distributed except according to the terms contained in
11
+the LICENSE file.
12
+
13
+-}
14
+
15
+--------------------------------------------------------------------------------
16
+-- | A more complete interface for recursively downloading a
17
+-- 'Playlist'.  For a simple interface for downloading playlists see
18
+-- 'Text.Playlist.HTTP.Simple'.
19
+module Text.Playlist.HTTP.Full
20
+  ( download
21
+  , Error (..)
22
+  , Environment (..)
23
+  , ByteStatus (..)
24
+  , module Playlist
25
+  ) where
26
+
27
+--------------------------------------------------------------------------------
28
+-- Package imports:
29
+import Control.Monad.Catch
30
+import Control.Monad.RWS.Strict
31
+import Control.Monad.Trans.Either
32
+import qualified Data.Attoparsec.ByteString as Atto
33
+import Data.ByteString (ByteString)
34
+import qualified Data.ByteString as ByteString
35
+import Data.Text (Text)
36
+import qualified Data.Text as Text
37
+import Network.HTTP.Client
38
+import Text.Playlist as Playlist
39
+
40
+--------------------------------------------------------------------------------
41
+-- | Possible error values produced while downloading and resolving a
42
+-- 'Playlist'.
43
+data Error = InvalidURL Text              -- ^ URL could not be parsed.
44
+           | ResponseTooLarge             -- ^ Byte limit exceeded.
45
+           | ProtocolError HttpException  -- ^ HTTP/Network error.
46
+           | FailedToParse String         -- ^ Invalid playlist format.
47
+           | FailedOnException String     -- ^ Unknown exception.
48
+           deriving Show
49
+
50
+--------------------------------------------------------------------------------
51
+-- | A status flag used to indicate if a download byte limit has been reached.
52
+data ByteStatus = Continue      -- ^ Continue processing network data.
53
+                | LimitReached  -- ^ Abort playlist processing.
54
+
55
+--------------------------------------------------------------------------------
56
+-- | Details needed by the 'download' function to operate.
57
+data Environment = Environment
58
+  { -- | A 'Manager' object from the 'Network.HTTP.Client' library.
59
+    -- If you want the download to take place via a TLS/SSL connection
60
+    -- you need to create the 'Manager' object correctly using the
61
+    -- @http-client-tls@ package.
62
+    httpManager :: Manager
63
+
64
+  , -- | A function that is used to limit the number of bytes that are
65
+    -- downloaded while recursively processing playlists.
66
+    --
67
+    -- It is given the current number of bytes that have been
68
+    -- downloaded/processed and should return a 'ByteStatus'.
69
+    httpByteCheck :: Int -> ByteStatus
70
+  }
71
+
72
+--------------------------------------------------------------------------------
73
+-- | Internal type used for keeping state.
74
+data State = State
75
+  { httpBytes :: Int
76
+  }
77
+
78
+--------------------------------------------------------------------------------
79
+-- | Internal type used for managing state, access to the environment,
80
+-- and access to IO.
81
+newtype Download m a =
82
+  Download { runDownload :: RWST Environment () State (EitherT Error m) a }
83
+
84
+  deriving ( Functor
85
+           , Applicative
86
+           , Monad
87
+           , MonadIO
88
+           , MonadReader Environment
89
+           , MonadState State
90
+           )
91
+
92
+--------------------------------------------------------------------------------
93
+-- | 'MonadThrow' instance for 'Download'.
94
+instance (Monad m) => MonadThrow (Download m) where
95
+  throwM = Download . lift . left . FailedOnException . show
96
+
97
+--------------------------------------------------------------------------------
98
+-- | Internal helper function for getting a result out of a 'Download'
99
+-- computation.  Returns the result and the final state.
100
+runS :: (Monad m)
101
+     => Download m a
102
+     -> Environment
103
+     -> State
104
+     -> m (Either Error (a, State))
105
+runS d e s = do
106
+  result <- runEitherT $ runRWST (runDownload d) e s
107
+  case result of
108
+    Left err         -> return (Left err)
109
+    Right (x, s', _) -> return (Right (x, s'))
110
+
111
+--------------------------------------------------------------------------------
112
+-- | Internal helper function for merging the state of one 'Download'
113
+-- computation into another.  Mostly used for when the @m@ value below
114
+-- is two different monads (e.g. generic @MonadIO@ and @IO@).
115
+merge :: (Monad m) => Download m (a, State) -> Download m a
116
+merge k = do
117
+  (x, s) <- k
118
+  put s
119
+  return x
120
+
121
+--------------------------------------------------------------------------------
122
+-- | Given an 'Environment' and a URL, recursively download and
123
+-- process a playlist.
124
+--
125
+-- For an example of using this function see the @example.hs@ file
126
+-- included in this package.
127
+download :: forall m. (MonadIO m)
128
+         => Environment
129
+         -> Text
130
+         -> m (Either Error Playlist)
131
+download env startURL = fmap fst <$> runS go env (State 0) where
132
+
133
+  ------------------------------------------------------------------------------
134
+  -- | Start playlist processing with the startURL.
135
+  go :: (MonadIO m) => Download m Playlist
136
+  go = resolve [Track startURL Nothing] fetch
137
+
138
+  ------------------------------------------------------------------------------
139
+  -- | Turn a URL into a HTTP Request object.
140
+  --
141
+  -- FIXME: Need a MonadCatch here to catch an invalid URL and
142
+  -- return the correct type of Error (InvalidURL).
143
+  request :: Text -> Download m Request
144
+  request = parseRequest . Text.unpack
145
+
146
+  ------------------------------------------------------------------------------
147
+  -- | Initiate a HTTP download in IO and then delegate the parsing of
148
+  -- the response body to the parseBody function.
149
+  fetch :: (MonadIO m) => Text -> Download m Playlist
150
+  fetch url = do
151
+    r <- request url
152
+    e <- ask
153
+    s <- get
154
+
155
+    -- Some voodoo to make a request in IO and process it in Download.
156
+    merge $ safeIO $ withResponse r (httpManager e) $
157
+      \body -> runS (parseBody url body) e s
158
+
159
+  ------------------------------------------------------------------------------
160
+  -- | Like liftIO but catch exceptions and turn them into an Error.
161
+  safeIO :: (MonadIO m) => IO (Either Error a) -> Download m a
162
+  safeIO action = io (catch action stop)
163
+    where
164
+      io a = Download (lift (hoistEither =<< liftIO a))
165
+      stop = return . Left . ProtocolError
166
+
167
+--------------------------------------------------------------------------------
168
+-- | Internal helper function to parse the body of a HTTP response.
169
+-- This function is written with @MonadIO m@ but will actually be run
170
+-- directly in @IO@ thanks to 'withResponse' :(
171
+parseBody :: forall m. (MonadIO m)
172
+          => Text
173
+          -> Response BodyReader
174
+          -> Download m Playlist
175
+parseBody url response = do
176
+    parser <- Download (lift (hoistEither lookupParser))
177
+    bytes  <- readChunk
178
+    dispatch (Atto.parse parser bytes)
179
+
180
+  where
181
+
182
+    ----------------------------------------------------------------------------
183
+    -- | Figure out which parser we should be using.
184
+    lookupParser :: Either Error (Atto.Parser Playlist)
185
+    lookupParser =
186
+      case parserForFormat <$> fileNameToFormat (Text.unpack url) of
187
+        Nothing     -> Left (InvalidURL url)
188
+        Just parser -> Right parser
189
+
190
+    ----------------------------------------------------------------------------
191
+    -- | Dispatch an attoparsec response.
192
+    dispatch :: (MonadIO m) => Atto.Result Playlist -> Download m Playlist
193
+    dispatch (Atto.Fail _ _ err) = Download . lift $ left (FailedToParse err)
194
+    dispatch (Atto.Partial f)    = readChunk >>= dispatch . f
195
+    dispatch (Atto.Done _ r)     = return r
196
+
197
+    ----------------------------------------------------------------------------
198
+    -- | Read bytes from the HTTP body.
199
+    readChunk :: (MonadIO m) => Download m ByteString
200
+    readChunk = do
201
+      check <- asks httpByteCheck
202
+      count <- gets httpBytes
203
+
204
+      case check count of
205
+        LimitReached -> Download . lift $ left ResponseTooLarge
206
+        Continue     -> do
207
+          bytes <- liftIO $ brRead (responseBody response)
208
+          modify' (\s -> s {httpBytes = ByteString.length bytes + count})
209
+          return bytes

+ 51
- 0
src/Text/Playlist/HTTP/Simple.hs View File

@@ -0,0 +1,51 @@
1
+{-
2
+
3
+This file is part of the Haskell package playlists-http. It is subject to
4
+the license terms in the LICENSE file found in the top-level directory
5
+of this distribution and at git://pmade.com/playlists-http/LICENSE. No part
6
+of playlists-http package, including this file, may be copied, modified,
7
+propagated, or distributed except according to the terms contained in
8
+the LICENSE file.
9
+
10
+-}
11
+
12
+--------------------------------------------------------------------------------
13
+-- | A simple interface for recursively downloading a 'Playlist'.
14
+module Text.Playlist.HTTP.Simple
15
+  ( download
16
+  , module Playlist
17
+  ) where
18
+
19
+--------------------------------------------------------------------------------
20
+-- Package imports:
21
+import Data.Text (Text)
22
+import Network.HTTP.Client
23
+import Text.Playlist as Playlist
24
+
25
+--------------------------------------------------------------------------------
26
+-- Local imports:
27
+import Text.Playlist.HTTP.Full (Environment(..), ByteStatus(..))
28
+import qualified Text.Playlist.HTTP.Full as Full
29
+
30
+--------------------------------------------------------------------------------
31
+-- | Download the playlist whose URL is given in the first argument.
32
+-- If the downloaded playlist references other playlists then it will
33
+-- be recursively processed/downloaded.
34
+--
35
+-- This function will not download more than 5MB total.
36
+--
37
+-- This function does not support TLS/SSL.
38
+--
39
+-- For more control over the download limit, for using TLS/SSL, and
40
+-- for proper error reporting, use the @download@ function from
41
+-- 'Text.Playlist.HTTP.Full'.
42
+download :: Text -> IO (Maybe Playlist)
43
+download url = do
44
+    manager <- newManager defaultManagerSettings
45
+    either (const Nothing) Just <$> Full.download (env manager) url
46
+  where
47
+    env :: Manager -> Environment
48
+    env m = Environment m under5MB
49
+
50
+    under5MB :: Int -> ByteStatus
51
+    under5MB n = if n < 5242880 then Continue else LimitReached

+ 10
- 0
stack.yaml View File

@@ -0,0 +1,10 @@
1
+resolver: lts-6.25
2
+
3
+packages:
4
+- ../playlists
5
+- ./
6
+
7
+flags:
8
+  playlists-http:
9
+    maintainer: true
10
+    build-examples: true

Loading…
Cancel
Save