Scripting in Haskell and PureScript

Posted on July 8, 2019 by Riccardo

When learning how to jump with the snowboard, my trainer used to say: “you need to take a lot of air”. In other words, if you want to learn how to jump, you need to jump a lot.

Functional programming is a skill like many others. Thus, we need to do a lot of it to get fluent with the paradigm. This is difficult since most of us at work do object oriented programming.

Recently, at Monadic Party somebody told me that a good trick to do functional at work is to write scripts. I would have never considered Haskell or PureScript as scripting languages. Turns out it’s not only easy to do, but also a great idea to do more FP.

In this post, we are gonna see the setup needed to write scripts in both Haskell and PureScript. Also, we are gonna take a look at the Haskell script I wrote at Monadic Party to test the idea.

Haskell Stack Scripting

As the website puts it

Stack is a cross-platform program for developing Haskell projects

The best thing is that Stack provides an interpreter for scripts.

The “Hello, World!” would be

That can be run with

It’s possible to import packages as any other Haskell program. For example, the following script uses directory to do something similar to ls in Bash:

PureScript Scripting

Since PureScript compiles to JavaScript we can use Node as our interpreter. First, we scaffold a PureScript project with pulp init

That generates a src/Main.purs that looks like

Then we can compile to a Node file with

And interpret the file with node

Alternatively we can create a small shim and interpret it with the node interpreter

The ls script in PureScript uses two additional packages that we can install with

and looks like

The downside of scripting with PureScript is that we need to keep around the entire “project” directory. With Stack there’s only the script file to take care of.

A non-trivial Haskell Stack Script

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

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

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}

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

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

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

instance ToJSON Package where
    toEncoding = genericToEncoding defaultOptions
instance FromJSON Package

data Response =
  Response [Package] deriving (Generic, Show)

instance ToJSON Response where
    toEncoding = genericToEncoding defaultOptions
instance FromJSON Response

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 (T.pack "formulae.brew.sh") /: (T.pack "api") /: (T.pack "cask.json"))
    NoReqBody
    jsonResponse
    mempty
  pure $ fmap Cask $ unNames $ (responseBody res :: Response)

unNames :: Response -> [String]
unNames (Response xs) = unName <$> xs

unName :: Package -> String
unName (Package name) = head name

writeBrewfile :: [BrewfileLine] -> IO ()
writeBrewfile lines = do
  let lines' = unlines $ fmap show $ sort $ nub lines
  writeFile "Brewfile" lines'

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

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
  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 "\"")

Outro

Special thanks to Justin from whom I blatantly copied half of this post. Be sure to check his “Write a simple CLI in PureScript”.