Skip to content

Instantly share code, notes, and snippets.

@ksqsf
Created January 21, 2022 07:24
Show Gist options
  • Save ksqsf/200d4f94e0f04e13558172e5c133008e to your computer and use it in GitHub Desktop.
Save ksqsf/200d4f94e0f04e13558172e5c133008e to your computer and use it in GitHub Desktop.
A script to create the Lambdacats sticker pack
#!/usr/bin/env cabal
{- cabal:
build-depends: base, scalpel, process, async, filepath, directory
ghc-options: -threaded -rtsopts -with-rtsopts=-N
-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import Text.HTML.Scalpel
import System.Directory
import Control.Concurrent.Async
import System.Process
import System.FilePath.Posix
main :: IO ()
main = do
let url = "https://lambdacats.github.io/"
basedir = "/tmp/lambdacats"
Just imgRelLinks <- scrapeURL url (attrs "src" "img")
createDirectoryIfMissing True basedir
let imgLinks = map (url ++) imgRelLinks
fileNames = map takeFileName imgRelLinks
destPaths = map (basedir </>) fileNames
mapConcurrently_ download (zip imgLinks destPaths)
mapConcurrently_ makeSticker destPaths
download :: (URL, FilePath) -> IO ()
download (url, dest) = callProcess "wget" [url, "-O", dest]
makeSticker :: FilePath -> IO ()
makeSticker inputPath = do
let png = replaceExtension inputPath "png"
outputPath = replaceExtension inputPath "webp"
callProcess "convert" [inputPath, "-resize", "512x512", png]
callProcess "cwebp" [png, "-o", outputPath]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment