A Haskell stack script to generate stack scripts!

GenStackScript.hs

#!/usr/bin/env stack
{- stack
   script
   --resolver lts-8.22
   --package http-conduit
   --package aeson
   --package text
   --package unordered-containers
   --package directory
-}

{-# LANGUAGE OverloadedStrings #-}

-- swap `script` with `exec ghci` to load script into ghci REPL

{- |
File        : GenStackScript.hs
Description : A tiny stack script to generate stack scripts!
Author      : Mike McGirr
Copyright   : (c) Mike McGirr, 2017
License     : GPL-2

This file when executed with an argument will create a file, with
the name given in the argument, in the current working directory.
The cool thing is that it will fill that file with the initial
code for a stack script and it will lookup the latest stackage
lts version and fill that detail in.
It's best to place this file somewhere on your path like /usr/local/bin/
-}

import Network.HTTP.Simple

import Data.Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T

import System.Environment
import System.Directory
import System.IO

-- this returns a string with the lts variable filled in
genScript :: String -> String
genScript lts = "#!/usr/bin/env stack\n\
 \{- stack\n\
 \   script\n\
 \   --resolver " ++ lts ++ "\n" ++
 "   --package turtle\n\
 \-}\n\
 \\n\
 \{-# LANGUAGE OverloadedStrings #-}\n\
 \\n\
 \-- swap `script` with `exec ghci` to load script into ghci REPL\n\
 \\n\
 \import Turtle\n"

-- manual lookup of the JSON value for the latest lts
parseLTS :: Value -> Maybe String
parseLTS (Object obj) = do
  let mLTS = HM.lookup "lts" obj
  fieldLTS <- case mLTS of
    Just l  -> return l
    Nothing -> fail "no lts field found"
  lts <- case fieldLTS of
    String x -> return (T.unpack x)
    _        -> fail "expected a String"
  return lts

main = do
  -- get the desired name of the script to be created
  [scriptName] <- getArgs
  -- get location that the script was run in (not where the file is)
  currentDirectory <- getCurrentDirectory
  let scriptFileName = (currentDirectory ++ "/" ++ scriptName ++ ".hs")
  -- check that there is no file with that name in the location
  exists <- doesFileExist scriptFileName
  response <- httpJSON "https://s3.amazonaws.com/haddock.stackage.org/snapshots.json"
  let body = (getResponseBody response :: Value)
  case parseLTS body of
    Nothing -> putStrLn "Something went wrong - no lts"
    Just lts -> if exists
      then putStrLn "File already exists"
      else do
          writeFile scriptFileName (genScript lts)
          p <- getPermissions scriptFileName
          setPermissions scriptFileName (setOwnerExecutable True p)