content: #!/usr/bin/env stack
  {- stack
    --resolver lts-20.9 script
    --package bytestring
    --package http-client-tls
    --package http-client
    --package http-types
    --package text
    --package split
  -}
  
  {-# LANGUAGE TupleSections #-}
  -- |
  -- A small script which regenerates the LICENSE file with all
  -- dependencies' licenses, when the dependencies are provided via standard
  -- input.
  --
  -- It is recommended to run this as follows:
  --
  -- stack ls dependencies --flag purescript:RELEASE | stack license-generator/generate.hs > LICENSE
  --
  
  module Main (main) where
  
  import Control.Monad (forM_, when)
  import Data.Char (isSpace, toLower)
  import Data.Maybe (mapMaybe)
  import Data.List
  import Data.List.Split (splitOn)
  import Data.Foldable
  import Data.Traversable
  import qualified Data.ByteString.Lazy as LBS
  import qualified Data.Text.Lazy as TL
  import qualified Data.Text.Lazy.Encoding as TLE
  import Network.HTTP.Types (ok200)
  import Network.HTTP.Client (Manager, newManager, httpLbs, parseRequest, responseBody, responseStatus)
  import Network.HTTP.Client.TLS (tlsManagerSettings)
  import System.IO (hPutStrLn, stderr, getContents)
  import System.Exit (exitFailure)
  
  main :: IO ()
  main = do
    deps <- depsNamesAndVersions
    echoHeader
    putStrLn ""
    forM_ deps $ \(d, _) -> putStr "  " >> putStrLn d
    putStrLn ""
    manager <- newManager tlsManagerSettings
    results <- traverse (\d -> (d,) <$> depsLicense manager d) deps
    echoLgpl
    let failures = filter (not . snd) results
    if not (null failures)
      then do
        hPutStrLn stderr "Licenses were not found for the following packages:"
        traverse_ (hPutStrLn stderr . showPair . fst) failures
        exitFailure
      else
        hPutStrLn stderr "Everything looks ok."
  
    where
    showPair (pkg, version) = pkg ++ " " ++ version
  
  echoHeader :: IO ()
  echoHeader =
    readFile "license-generator/header.txt" >>= putStr
  
  echoLgpl :: IO ()
  echoLgpl = 
    readFile "license-generator/lgpl.txt" >>= putStr
  
  depsNamesAndVersions :: IO [(String, String)]
  depsNamesAndVersions = do
    contents <- lines <$> getContents
    deps <- traverse parse contents
    pure (filter (\(name, _) -> not (excluded name)) deps)
  
    where
    excluded name =
      name == "purescript"
      || name == "rts"
      || name == "ghc-boot-th"
  
    parse line =
      case splitOn " " line of
        [pkg, vers] -> pure (pkg, vers)
        _ -> fail $ "Unable to parse input line: " ++ line
  
  -- Returns True on success, False on failure.
  depsLicense :: Manager -> (String, String) -> IO Bool
  depsLicense manager dep = do
    hPutStrLn stderr (fst dep)
    result <- downloadLicenseFromHackage manager dep
    case result of
      FoundLicense license -> do
        putStrLn $ fst dep ++ " LICENSE file:"
        putStrLn ""
        putStrLn $ f license
        pure True
      LicenseNotNeeded ->
        pure True
      Failed ->
        pure False
    where
    f = unlines . map (trimEnd . ("  " ++)) . lines
    trimEnd = reverse . dropWhile isSpace . reverse
  
  data LicenseResult
    = FoundLicense String
    | LicenseNotNeeded
    | Failed
    deriving (Show, Eq, Ord)
  
  downloadLicenseFromHackage :: Manager -> (String, String) -> IO LicenseResult
  downloadLicenseFromHackage manager dep = do
    mcabalFile <- downloadCabalFileFromHackage manager dep
    case mcabalFile of
      Nothing ->
        pure Failed
      Just cabalFile ->
        let
          field f = extractCabalField f cabalFile
        in
          case (field "license", field "license-file") of
            (_, Just licenseFile) -> do
              getLicense licenseFile
            (Just "PublicDomain", _) -> do
              pure LicenseNotNeeded
            _ -> do
              hPutStrLn stderr $
                "Unable to extract license information from cabal file for " ++
                fst dep
              pure Failed
  
    where
    getLicense licenseFile = do
      r <- downloadFromHackage ("/src/" ++ licenseFile) manager dep
      pure $ maybe Failed FoundLicense r
  
  -- Attempt to extract a field from a cabal file. Note that this only works for
  -- fields which are at the top level, not inside subsections such as
  -- 'executable' or 'test-suite'.
  extractCabalField :: String -> String -> Maybe String
  extractCabalField fieldName cabalFile =
    case mapMaybe (stripPrefixCaseInsensitive fieldName) (lines cabalFile) of
      [line] ->
        Just $
          line
          |> dropWhile isSpace
          |> drop 1 -- colon
          |> trim
      _ ->
        Nothing
    where
    x |> f = f x
  
    trim =
      reverse . dropWhile isSpace . reverse . dropWhile isSpace
  
    stripPrefixCaseInsensitive prefix str =
      if map toLower prefix `isPrefixOf` map toLower str
        then Just (drop (length prefix) str)
        else Nothing
  
  downloadCabalFileFromHackage :: Manager -> (String, String) -> IO (Maybe String)
  downloadCabalFileFromHackage manager dep = do
    downloadFromHackage ("/src/" ++ fst dep ++ ".cabal") manager dep
  
  downloadFromHackage :: String -> Manager -> (String, String) -> IO (Maybe String)
  downloadFromHackage urlpath manager dep = do
    let url = hackageBaseUrl dep ++ urlpath
    req <- parseRequest url
    resp <- httpLbs req manager
  
    let status = responseStatus resp
    if status /= ok200
      then do
        hPutStrLn stderr $ "Bad status code for " ++ url
        hPutStrLn stderr $ "Expected 200, got " ++ show status
        pure Nothing
      else
        pure (Just (toString (responseBody resp)))
  
    where
    toString = TL.unpack . TLE.decodeUtf8
  
  hackageBaseUrl :: (String, String) -> String
  hackageBaseUrl (dep, version) =
    concat
      [ "https://hackage.haskell.org/package/"
      , dep
      , "-"
      , version
      ]
  