loading...

Homebrew Brewfile Dump with Haskell

riccardoodone profile image Riccardo Odone Updated on ・3 min read

You can keep reading here or jump to my blog to get the full experience, including the wonderful pink, blue and white palette.


Have I ever mentioned how scripts are a great way to put Haskell to use? Here comes another one. In fact, the first Haskell script I have ever wrote. Believe it or not I put it together on the train back from Monadic Party last year.

Today I would write code in a different way. However, the beauty of Haskell is that after several months I can easily make sense of it and refactor without breaking a sweat. It would not be the same had I coded it in Bash.

#!/usr/bin/env stack
{- stack
  script
  --resolver nightly-2019-06-20
  --package directory
  --package req
  --package aeson
  --package process
  --package parsec
  --package filepath
  --package unix
-}

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- This script creates a Brewfile using `brew bundle dump`
-- and adds to that all the apps from `/Applications`
-- that can be installed via Homebrew as casks.
--
-- Later you can use `brew bundle` to install or upgrade
-- all dependencies listed the Brewfile.
--
-- It can be useful to restore the same packages and apps
-- on a different Mac.

import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson
import Data.Char
import Data.List
import GHC.Generics
import Network.HTTP.Req
import System.Directory
import System.Exit
import System.FilePath.Posix
import System.Posix.Files
import System.Process
import Text.Parsec

newtype Response
  = Response [Package]
  deriving (Generic, Show, ToJSON, FromJSON)

newtype Package = Package {name :: [String]}
  deriving (Generic, Show, ToJSON)

instance FromJSON Package where
  parseJSON = withObject "Package" $ \v ->
    Package <$> v .: "name"

data BrewfileLine
  = Tap String
  | Brew String
  | Cask String
  deriving (Eq)

instance Show BrewfileLine where
  show (Tap s) = "tap \"" <> s <> "\""
  show (Brew s) = "brew \"" <> s <> "\""
  show (Cask s) = "cask \"" <> s <> "\""

instance Ord BrewfileLine where
  (<=) (Tap s1) (Tap s2) = fmap toLower s1 <= fmap toLower s2
  (<=) (Tap _) _ = True
  (<=) (Brew s1) (Brew s2) = fmap toLower s1 <= fmap toLower s2
  (<=) (Brew _) _ = True
  (<=) (Cask s1) (Cask s2) = fmap toLower s1 <= fmap toLower s2
  (<=) (Cask _) _ = False

main :: IO ()
main = do
  doesBrewfileExist <- fileExist "Brewfile"
  when doesBrewfileExist $ die "Brewfile already exists! Aborted."
  installed <- getInstalledApps
  installable <- fetchInstallableAppsWithBrew
  let casks = installed `intersect` installable
  lines <- getBrewDumpLines
  let all = union casks <$> lines
  either
    (die . show)
    (writeBrewfile >=> \_ -> putStrLn "Brewfile generated!")
    all

getInstalledApps :: IO [BrewfileLine]
getInstalledApps = do
  filePaths <- listDirectory "/Applications"
  let names = takeBaseName <$> filePaths
  pure $ Cask <$> names

fetchInstallableAppsWithBrew :: IO [BrewfileLine]
fetchInstallableAppsWithBrew = runReq defaultHttpConfig $ do
  res <-
    req
      GET
      (https "formulae.brew.sh" /: "api" /: "cask.json")
      NoReqBody
      jsonResponse
      mempty
  pure . fmap Cask . unNames $ (responseBody res :: Response)

unNames :: Response -> [String]
unNames (Response xs) = unName <$> xs
  where
    unName :: Package -> String
    unName (Package name) = head name

getBrewDumpLines :: IO (Either ParseError [BrewfileLine])
getBrewDumpLines = do
  out <- readProcess "brew" ["bundle", "dump", "--file=/dev/stdout"] []
  pure $ parse brewfileParser "" out

writeBrewfile :: [BrewfileLine] -> IO ()
writeBrewfile =
  writeFile "Brewfile" . unlines . fmap show . sort . nub

-- PARSER

brewfileParser :: Stream s m Char => ParsecT s u m [BrewfileLine]
brewfileParser = endBy1 brewfileLine $ char '\n'

brewfileLine :: Stream s m Char => ParsecT s u m BrewfileLine
brewfileLine =
  brewfileLine' "tap" Tap
    <|> brewfileLine' "brew" Brew
    <|> brewfileLine' "cask" Cask

brewfileLine' :: Stream s m Char => String -> (String -> BrewfileLine) -> ParsecT s u m BrewfileLine
brewfileLine' prefix constructor = do
  string $ prefix <> " "
  name <- quoted
  skipMany $ satisfy (/= '\n')
  pure $ constructor name

quote :: Stream s m Char => ParsecT s u m Char
quote = char '"'

quoted :: Stream s m Char => ParsecT s u m String
quoted = between quote quote (many1 $ noneOf "\"")

Get the latest content via email from me personally. Reply with your thoughts. Let's learn from each other. Subscribe to my PinkLetter!

Posted on by:

riccardoodone profile

Riccardo Odone

@riccardoodone

🏳️‍🌈 Pronoun.is/he 💣 Maverick & Leader @Lunar_Logic 🧑‍💻 Functional Programming Rambler 🔥 Sometimes failing 🚀 Sometimes succeeding 💡Always learning

Discussion

markdown guide