chore(users/Profpatsch): bring reverse-haskell-deps into shape
Add a cabal file and move into subdir. Use MyPrelude & fix a few linter warnings. Change-Id: I19d5ba47be789fc24f8e02ee8721f73c706ae3e9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/8465 Reviewed-by: Profpatsch <mail@profpatsch.de> Autosubmit: Profpatsch <mail@profpatsch.de> Tested-by: BuildkiteCI
This commit is contained in:
parent
6edc2182d1
commit
5e400b5b24
4 changed files with 59 additions and 37 deletions
|
@ -1,72 +1,76 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# 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
|
||||
module Main where
|
||||
|
||||
import Data.ByteString qualified as ByteString
|
||||
import Data.Either
|
||||
import Data.List qualified as List
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.Encoding qualified
|
||||
import MyPrelude
|
||||
import Numeric.Natural
|
||||
import Text.HTML.TagSoup qualified as Tag
|
||||
import Text.Nicify
|
||||
import Text.Read qualified as Read
|
||||
|
||||
parseNat :: Text -> Maybe Natural
|
||||
parseNat = Read.readMaybe . textToString
|
||||
|
||||
printNice :: Show a => a -> IO ()
|
||||
printNice = putStrLn . nicify . show
|
||||
|
||||
type Tag = Tag.Tag Text.Text
|
||||
type Tag = Tag.Tag Text
|
||||
|
||||
main = do
|
||||
reverseHtml <- readStdinUtf8
|
||||
printNice $ List.sortOn snd $ packagesAndReverseDeps reverseHtml
|
||||
|
||||
where
|
||||
readStdinUtf8 = Data.Text.Encoding.decodeUtf8 <$> ByteString.getContents
|
||||
readStdinUtf8 = bytesToTextUtf8Lenient <$> 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 :: Text -> [(Text, Natural)]
|
||||
packagesAndReverseDeps reverseHtml = do
|
||||
let tags = Tag.parseTags reverseHtml
|
||||
let sections = Tag.partitions (isJust . reverseLink) tags
|
||||
let sectionNames = map (fromJust . reverseLink . head) sections
|
||||
let sections = Tag.partitions (isJust . reverseLink) tags
|
||||
let sectionName [] = "<unknown section>"
|
||||
sectionName (sect : _) = sect & reverseLink & fromMaybe "<unknown section>"
|
||||
let sectionNames = map sectionName sections
|
||||
mapMaybe
|
||||
(\(name :: Text.Text, sect) -> do
|
||||
( \(name :: Text, sect) -> do
|
||||
reverseDeps <- firstNaturalNumber sect
|
||||
pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text.Text, Natural))
|
||||
pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text, Natural)
|
||||
)
|
||||
$ zip sectionNames sections
|
||||
|
||||
|
||||
where
|
||||
reverseLink = \case
|
||||
Tag.TagOpen "a" attrs -> mapFind attrReverseLink attrs
|
||||
Tag.TagOpen "a" attrs -> findMaybe attrReverseLink attrs
|
||||
_ -> Nothing
|
||||
|
||||
attrReverseLink = \case
|
||||
("href", lnk) -> if
|
||||
| "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk
|
||||
| otherwise -> Nothing
|
||||
("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
|
||||
(_ : 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
|
||||
findMaybe
|
||||
( \case
|
||||
Tag.TagText t -> parseNat t
|
||||
_ -> Nothing
|
||||
)
|
|
@ -19,12 +19,13 @@ let
|
|||
rev-hs = pkgs.writers.writeHaskell "revers-haskell-deps-hs"
|
||||
{
|
||||
libraries = [
|
||||
depot.users.Profpatsch.my-prelude
|
||||
pkgs.haskellPackages.nicify-lib
|
||||
pkgs.haskellPackages.tagsoup
|
||||
];
|
||||
|
||||
}
|
||||
./reverse-haskell-deps.hs;
|
||||
./ReverseHaskellDeps.hs;
|
||||
|
||||
|
||||
in
|
|
@ -0,0 +1,16 @@
|
|||
cabal-version: 2.4
|
||||
name: reverse-haskell-deps
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
maintainer: mail@profpatsch.de
|
||||
|
||||
library
|
||||
exposed-modules: ReverseHaskellDeps.hs
|
||||
|
||||
build-depends:
|
||||
base >=4.15 && <5,
|
||||
my-prelude,
|
||||
tagsoup,
|
||||
nicify-lib
|
||||
|
||||
default-language: Haskell2010
|
|
@ -29,6 +29,7 @@ pkgs.mkShell {
|
|||
h.nonempty-containers
|
||||
h.deriving-compat
|
||||
h.unix
|
||||
h.tagsoup
|
||||
h.attoparsec
|
||||
h.iCalendar
|
||||
h.case-insensitive
|
||||
|
|
Loading…
Reference in a new issue