blob: 6b644df9ecc657acff7d1498a1af513f273bda79 (
plain) (
blame)
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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
import qualified Text.HTML.TagSoup as Tag
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.List as List
import Data.Maybe
import Text.Nicify
import qualified Text.Read as Read
import Numeric.Natural
import Data.Either
import qualified Data.ByteString as ByteString
import qualified Data.Text.Encoding
parseNat :: Text.Text -> Maybe Natural
parseNat = Read.readMaybe . Text.unpack
printNice :: Show a => a -> IO ()
printNice = putStrLn . nicify . show
type Tag = Tag.Tag Text.Text
main = do
reverseHtml <- readStdinUtf8
printNice $ List.sortOn snd $ packagesAndReverseDeps reverseHtml
where
readStdinUtf8 = Data.Text.Encoding.decodeUtf8 <$> ByteString.getContents
-- | reads the table provided by https://packdeps.haskellers.com/reverse
-- figuring out all sections (starting with the link to the package name),
-- then figuring out the name of the package and the first column,
-- which is the number of reverse dependencies of the package
packagesAndReverseDeps reverseHtml = do
let tags = Tag.parseTags reverseHtml
let sections = Tag.partitions (isJust . reverseLink) tags
let sectionNames = map (fromJust . reverseLink . head) sections
mapMaybe
(\(name :: Text.Text, sect) -> do
reverseDeps <- firstNaturalNumber sect
pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text.Text, Natural))
$ zip sectionNames sections
where
reverseLink = \case
Tag.TagOpen "a" attrs -> mapFind attrReverseLink attrs
_ -> Nothing
attrReverseLink = \case
("href", lnk) -> if
| "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk
| otherwise -> Nothing
_ -> Nothing
sectionPackageName :: Text -> [Tag] -> Text
sectionPackageName sectionName = \case
(_: Tag.TagText name : _) -> name
(_: el : _) -> sectionName
xs -> sectionName
firstNaturalNumber :: [Tag] -> Maybe Natural
firstNaturalNumber =
mapFind (\case
Tag.TagText t -> parseNat t
_ -> Nothing)
mapFind :: (a -> Maybe b) -> [a] -> Maybe b
mapFind f xs = fromJust . f <$> List.find (isJust . f) xs
|
