<commit_before>{-# LANGUAGE LambdaCase #-}

{-| Calling LiquidHaskell via the source plugin.
  This executable is a simple wrapper around 'ghc', which gets passed an '-fplugin' option.
-}

import Control.Monad

import System.Environment (lookupEnv, getArgs, unsetEnv)
import System.FilePath ((</>), takeDirectory)
import System.Process
import System.Exit
import Data.Maybe
import Data.Either (partitionEithers)
import Data.Bifunctor
import Data.Functor ((<&>))
import qualified System.Console.CmdArgs.Explicit as CmdArgs
import Data.List (partition, isPrefixOf, (\\))

import Language.Haskell.Liquid.UX.CmdLine (config, printLiquidHaskellBanner, getOpts)

type GhcArg    = String
type LiquidArg = String

partitionArgs :: [String] -> ([GhcArg], [LiquidArg])
partitionArgs args = partitionEithers (map parseArg args)
  where
    parseArg :: String -> Either GhcArg LiquidArg
    parseArg a
      | forwardToGhc a = Left a
      | otherwise      = bimap (const a) (const a) (CmdArgs.process config [a])

    -- Unfortunate consequence of the facts things like '-i' needs to be forwarded to GHC
    -- and not the LH executable.
    forwardToGhc :: String -> Bool
    forwardToGhc = isPrefixOf "-i"


helpNeeded :: [String] -> Bool
helpNeeded = elem "--help"

collectPackageDbsFromGHC_ENVIRONMENT :: IO [FilePath]
collectPackageDbsFromGHC_ENVIRONMENT = do
  lookupEnv "GHC_ENVIRONMENT" >>= \case
    Nothing -> return []
    Just envFile -> do
      contents <- readFile envFile
      return
        [ takeDirectory envFile </> drop (length pfx) xs
        | xs <- lines contents
        , let pfx = "package-db "
        , isPrefixOf pfx xs
        ]

main :: IO a
main = do

  -- If no args are passed, display the help instead of ghc's "no input files." To do so,
  -- due to the fact GHC needs to always have an input file to actually run a source plugin, we
  -- run this with '--interactive'.
  args <- getArgs <&> \case [] -> ["--interactive", "--help"]
                            xs -> "--make" : xs

  ghcPath <- fromMaybe "ghc" <$> lookupEnv "LIQUID_GHC_PATH"

  packageDbs <- collectPackageDbsFromGHC_ENVIRONMENT

  -- Strip targets out of the arguments, so that we can forward them to GHC before they
  -- get intercepted by the LH parser.
  let (cliArgs, targets)    = partition (isPrefixOf "-") args
  let (ghcArgs, liquidArgs) = partitionArgs cliArgs

  let p = proc ghcPath $
                         ["-package-env", "-"]
                         <> concat [ ["-package-db", p] | p <- packageDbs ]
                         <>
                         [ "-O0"
                         , "-no-link"
                         , "-fplugin=LiquidHaskell"
                         , "-plugin-package", "liquidhaskell"
                         , "-package", "liquid-ghc-prim"
                         , "-package", "liquid-base"
                         , "-package", "liquid-containers"
                         , "-package", "liquid-prelude"
                         , "-package", "liquid-vector"
                         , "-package", "liquid-bytestring"
                         , "-hide-package", "ghc-prim"
                         , "-hide-package", "base"
                         , "-hide-package", "containers"
                         , "-hide-package", "vector"
                         , "-hide-package", "bytestring"
                         , "-fplugin-opt=LiquidHaskell:--normal" -- normal logging.
                         ]
                         <> map (mappend "-fplugin-opt=LiquidHaskell:") liquidArgs
                         <> ghcArgs
                         <> targets

  -- Call into 'getOpts' so that things like the json reporter will correctly set the verbosity of the
  -- logging and avoid printing the banner.
  _ <- getOpts (args \\ ghcArgs)
  unless (helpNeeded args) printLiquidHaskellBanner

  -- Unset GHC_ENVIRONMENT so it doesn't influence ghc. Otherwise it would
  -- interfere when calling this program with cabal exec.
  unsetEnv "GHC_ENVIRONMENT"
  withCreateProcess p $ \_mbStdIn _mbStdOut _mbStdErr pHandle -> waitForProcess pHandle >>= exitWith
<commit_msg>Make parameter parsing a tad more reliable in liquid-platform:liquidhaskell<commit_after>{-# LANGUAGE LambdaCase #-}

{-| Calling LiquidHaskell via the source plugin.
  This executable is a simple wrapper around 'ghc', which gets passed an '-fplugin' option.
-}

import Control.Monad

import System.Environment (lookupEnv, getArgs, unsetEnv)
import System.FilePath ((</>), takeDirectory, takeExtension)
import System.Process
import System.Exit
import Data.Char (toLower)
import Data.Maybe
import Data.Either (partitionEithers)
import Data.Bifunctor
import Data.Functor ((<&>))
import qualified System.Console.CmdArgs.Explicit as CmdArgs
import Data.List (partition, isPrefixOf, (\\))

import Language.Haskell.Liquid.UX.CmdLine (config, printLiquidHaskellBanner, getOpts)

type GhcArg    = String
type LiquidArg = String

partitionArgs :: [String] -> ([GhcArg], [LiquidArg])
partitionArgs args = partitionEithers (map parseArg args)
  where
    parseArg :: String -> Either GhcArg LiquidArg
    parseArg a
      | forwardToGhc a = Left a
      | otherwise      = bimap (const a) (const a) (CmdArgs.process config [a])

    -- Unfortunate consequence of the facts things like '-i' needs to be forwarded to GHC
    -- and not the LH executable.
    forwardToGhc :: String -> Bool
    forwardToGhc = isPrefixOf "-i"


helpNeeded :: [String] -> Bool
helpNeeded = elem "--help"

collectPackageDbsFromGHC_ENVIRONMENT :: IO [FilePath]
collectPackageDbsFromGHC_ENVIRONMENT = do
  lookupEnv "GHC_ENVIRONMENT" >>= \case
    Nothing -> return []
    Just envFile -> do
      contents <- readFile envFile
      return
        [ takeDirectory envFile </> drop (length pfx) xs
        | xs <- lines contents
        , let pfx = "package-db "
        , isPrefixOf pfx xs
        ]

main :: IO a
main = do

  -- If no args are passed, display the help instead of ghc's "no input files." To do so,
  -- due to the fact GHC needs to always have an input file to actually run a source plugin, we
  -- run this with '--interactive'.
  args <- getArgs <&> \case [] -> ["--interactive", "--help"]
                            xs -> "--make" : xs

  ghcPath <- fromMaybe "ghc" <$> lookupEnv "LIQUID_GHC_PATH"

  packageDbs <- collectPackageDbsFromGHC_ENVIRONMENT

  -- Strip targets out of the arguments, so that we can forward them to GHC before they
  -- get intercepted by the LH parser.
  let (targets, cliArgs)    =
        partition ((`elem` [".o", ".hs", ".lhs"]) . map toLower . takeExtension) args
  let (ghcArgs, liquidArgs) = partitionArgs cliArgs

  let p = proc ghcPath $
                         ["-package-env", "-"]
                         <> concat [ ["-package-db", p] | p <- packageDbs ]
                         <>
                         [ "-O0"
                         , "-no-link"
                         , "-fplugin=LiquidHaskell"
                         , "-plugin-package", "liquidhaskell"
                         , "-package", "liquid-ghc-prim"
                         , "-package", "liquid-base"
                         , "-package", "liquid-containers"
                         , "-package", "liquid-prelude"
                         , "-package", "liquid-vector"
                         , "-package", "liquid-bytestring"
                         , "-hide-package", "ghc-prim"
                         , "-hide-package", "base"
                         , "-hide-package", "containers"
                         , "-hide-package", "vector"
                         , "-hide-package", "bytestring"
                         , "-fplugin-opt=LiquidHaskell:--normal" -- normal logging.
                         ]
                         <> map (mappend "-fplugin-opt=LiquidHaskell:") liquidArgs
                         <> ghcArgs
                         <> targets

  -- Call into 'getOpts' so that things like the json reporter will correctly set the verbosity of the
  -- logging and avoid printing the banner.
  _ <- getOpts (args \\ ghcArgs)
  unless (helpNeeded args) printLiquidHaskellBanner

  -- Unset GHC_ENVIRONMENT so it doesn't influence ghc. Otherwise it would
  -- interfere when calling this program with cabal exec.
  unsetEnv "GHC_ENVIRONMENT"
  withCreateProcess p $ \_mbStdIn _mbStdOut _mbStdErr pHandle -> waitForProcess pHandle >>= exitWith

{'fraction_non_alphanumeric': 0.10901717557251908, 'fraction_numerical': 0.00023854961832061068, 'mean_word_length': 2.0292630057803467, 'pattern_counts': {'":': 0, '<': 37, '<?xml version=': 0, '>': 49, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4125558', 'n_tokens_mistral': 2525, 'n_tokens_neox': 2332, 'n_words': 734}