Homebrew Brewfile Dump with Haskell
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
= withObject "Package" $ \v ->
parseJSON 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 ()
= do
main <- fileExist "Brewfile"
doesBrewfileExist $ die "Brewfile already exists! Aborted."
when doesBrewfileExist <- getInstalledApps
installed <- fetchInstallableAppsWithBrew
installable let casks = installed `intersect` installable
lines <- getBrewDumpLines
let all = union casks <$> lines
either
. show)
(die >=> \_ -> putStrLn "Brewfile generated!")
(writeBrewfile all
getInstalledApps :: IO [BrewfileLine]
= do
getInstalledApps <- listDirectory "/Applications"
filePaths let names = takeBaseName <$> filePaths
pure $ Cask <$> names
fetchInstallableAppsWithBrew :: IO [BrewfileLine]
= runReq defaultHttpConfig $ do
fetchInstallableAppsWithBrew <-
res
reqGET
"formulae.brew.sh" /: "api" /: "cask.json")
(https NoReqBody
jsonResponsemempty
pure . fmap Cask . unNames $ (responseBody res :: Response)
unNames :: Response -> [String]
Response xs) = unName <$> xs
unNames (where
unName :: Package -> String
Package name) = head name
unName (
getBrewDumpLines :: IO (Either ParseError [BrewfileLine])
= do
getBrewDumpLines <- readProcess "brew" ["bundle", "dump", "--file=/dev/stdout"] []
out 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]
= endBy1 brewfileLine $ char '\n'
brewfileParser
brewfileLine :: Stream s m Char => ParsecT s u m BrewfileLine
=
brewfileLine "tap" Tap
brewfileLine' <|> brewfileLine' "brew" Brew
<|> brewfileLine' "cask" Cask
brewfileLine' :: Stream s m Char => String -> (String -> BrewfileLine) -> ParsecT s u m BrewfileLine
= do
brewfileLine' prefix constructor $ prefix <> " "
string <- quoted
name $ satisfy (/= '\n')
skipMany pure $ constructor name
quote :: Stream s m Char => ParsecT s u m Char
= char '"'
quote
quoted :: Stream s m Char => ParsecT s u m String
= between quote quote (many1 $ noneOf "\"") quoted