init

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+*~
+*.pdf

README.md

@@ -0,0 +1,2 @@
+# Category Theory for Programmers on russian
+http://kanasama.me/rumilewski.pdf

Setup.hs

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

app/Main.hs

@@ -0,0 +1,74 @@
+module Main where
+
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as ByteString (unpack)
+import qualified Data.ByteString.Lazy as ByteString.Lazy (hPut)
+
+import Data.Traversable (for)
+import Data.Maybe (fromMaybe, catMaybes)
+
+import Control.Monad (when, void, guard)
+import Control.Monad.IO.Class (liftIO)
+
+import qualified Network.Wreq as Wreq (get, responseBody)
+import qualified Web.Scotty as Scotty (scotty, get, file)
+
+import Control.Concurrent (newMVar, readMVar, modifyMVar_)
+import Control.Concurrent.Async (async, wait, forConcurrently)
+
+import Control.Lens ((^.))
+
+import Text.HTML.Scalpel ((//), (@:))
+import qualified Text.HTML.Scalpel as Scalpel (Scraper, text, attr, attrs, hasClass, scrapeURL, chroot, anySelector)
+
+import System.IO (hClose)
+import System.IO.Temp (withSystemTempFile)
+import System.Process (system)
+
+type URI = String
+type Book = [String]
+
+fetchBook :: URI -> IO Book
+fetchBook url = do
+    pages <- fromMaybe [] <$> Scalpel.scrapeURL url do
+      Scalpel.chroot ("div" @: [Scalpel.hasClass "entry-content"]) do
+        preface <- link "Предисловие"
+        chapters <- Scalpel.attrs "href" ("li" // "a")
+        pure (preface : chapters)
+    chapters <- forConcurrently pages \page ->
+      Scalpel.scrapeURL page (link "Содержимое текущего раздела")
+    pure $ catMaybes chapters
+  where
+    link content = Scalpel.chroot "a" do
+      actual <- Scalpel.text Scalpel.anySelector
+      guard $ actual == ByteString.unpack (encodeUtf8 content)
+      Scalpel.attr "href" Scalpel.anySelector
+
+buildBook :: FilePath -> Book -> IO ()
+buildBook target book = go [] [] book where
+  go downloads files [] = do
+    for downloads wait
+    void $ system $ "pdfunite " <> unwords (reverse files) <> " " <> target
+  go downloads files (url : urls) = withSystemTempFile "chapter.pdf" \file handle -> do
+    download <- async do
+      pdf <- Wreq.get url
+      ByteString.Lazy.hPut handle (pdf ^. Wreq.responseBody)
+      hClose handle
+    go (download : downloads) (file : files) urls
+
+main :: IO ()
+main = do
+  cache <- newMVar []
+  Scotty.scotty 3000 $ Scotty.get "/rumilewski.pdf" do
+    actual <- liftIO $ fetchBook base
+    cached <- liftIO $ readMVar cache
+    when (cached /= actual) do
+      liftIO $ modifyMVar_ cache \_ -> do
+        actual <- fetchBook base
+        buildBook "rumilewski.pdf" actual
+        pure actual
+    Scotty.file "rumilewski.pdf"
+  where
+    base = "https://henrychern.wordpress.com/2017/07/17/httpsbartoszmilewski-com20141028category-theory-for-programmers-the-preface/"

package.yaml

@@ -0,0 +1,39 @@
+name:                rumilewski
+version:             0.1.0.0
+github:              "kana-sama/rumilewski"
+license:             BSD3
+author:              "kana-sama"
+maintainer:          "andrew4chrome@gmail.com"
+copyright:           "2020 kana-sama"
+
+extra-source-files:
+- README.md
+
+description:         Please see the README on GitHub at <https://github.com/kana-sama/rumilewski#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- scotty
+- wreq
+- bytestring
+- text
+- lens
+- scalpel
+- async
+- temporary
+- process
+
+default-extensions:
+- BlockArguments
+- LambdaCase
+- OverloadedStrings
+- RecordWildCards
+
+executables:
+  rumilewski-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N

rumilewski.cabal

@@ -0,0 +1,45 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: bb61886a7fd963536f2d50664467e1059023281b24526bf1d4fc52e1c370b880
+
+name:           rumilewski
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/kana-sama/rumilewski#readme>
+homepage:       https://github.com/kana-sama/rumilewski#readme
+bug-reports:    https://github.com/kana-sama/rumilewski/issues
+author:         kana-sama
+maintainer:     andrew4chrome@gmail.com
+copyright:      2020 kana-sama
+license:        BSD3
+build-type:     Simple
+extra-source-files:
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/kana-sama/rumilewski
+
+executable rumilewski-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_rumilewski
+  hs-source-dirs:
+      app
+  default-extensions: BlockArguments LambdaCase OverloadedStrings RecordWildCards
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      async
+    , base >=4.7 && <5
+    , bytestring
+    , lens
+    , process
+    , scalpel
+    , scotty
+    , temporary
+    , text
+    , wreq
+  default-language: Haskell2010

stack.yaml

@@ -0,0 +1,4 @@
+resolver: lts-15.7
+packages:
+- .
+extra-deps: []

stack.yaml.lock

@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+    size: 491389
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/7.yaml
+    sha256: 92ab6303fe20ec928461c82ce0980b4d17c06f4e66205a2967e476474f686c17
+  original: lts-15.7