<commit_before>{-# LANGUAGE GeneralizedNewtypeDeriving
  #-}
import System.Environment (getEnv, getProgName, getArgs, getEnvironment)
import System.IO (stderr, hPutStrLn, hGetContents, hPutStr, Handle)
import System.IO.Error (isDoesNotExistError)
import System.Exit (exitFailure, ExitCode(..))
import System.Process (readProcess, runInteractiveProcess, waitForProcess, runProcess)
import System.Cmd (rawSystem)
import System.Directory (getCurrentDirectory, createDirectory, executable, getPermissions, setPermissions)
import System.FilePath ((</>))
import Data.List (isPrefixOf, intercalate)
import Control.Monad
import Data.Char (isSpace)
import Distribution.Compat.ReadP
import Distribution.Package
import Distribution.Version
import Distribution.Text
import Data.Maybe(catMaybes)
import Control.Monad.Trans (MonadIO, liftIO)
import Control.Monad.Reader (ReaderT, MonadReader, runReaderT, ask, asks)
import Control.Monad.State (StateT, MonadState, evalStateT, modify, gets)

import Paths_virthualenv (getDataFileName)

data Options = Options { verbose :: Bool
                       , vheName :: String
                       }

data MyState = MyState { logDepth :: Integer
                       }

newtype MyMonad a = MyMonad { unMyMonad :: StateT MyState (ReaderT Options IO) a }
    deriving (Monad, MonadReader Options, MonadIO, MonadState MyState)

runMyMonad :: MyMonad a -> Options -> IO a
runMyMonad m = runReaderT (evalStateT (unMyMonad m) (MyState 0))

debugBlock :: MyMonad a -> MyMonad a
debugBlock m = do
  modify (\s -> s{logDepth = logDepth s + 2})
  result <- m
  modify (\s -> s{logDepth = logDepth s - 2})
  return result

debug :: String -> MyMonad ()
debug s = do
  flag <- asks verbose
  if flag then do
      depth <- gets logDepth
      liftIO $ putStrLn $ replicate (fromInteger depth) ' ' ++ s
   else
      return ()

-- run a process in a Virtual Haskell Environment
-- returns process output and exit status
envProcess :: String -> [String] -> Maybe Handle -> MyMonad (String, ExitCode)
envProcess prog args input = do
  env <- getVirtualEnvironment
  (inp, out, _, pid) <- liftIO $ runInteractiveProcess prog args Nothing (Just env)
  case input of
    Nothing     -> return ()
    Just handle -> liftIO $ hGetContents handle >>= hPutStr inp
  result   <- liftIO $ hGetContents out
  exitCode <- liftIO $ waitForProcess pid
  return (result, exitCode)

data DirStructure = DirStructure { virthualEnv       :: FilePath
                                 , virthualEnvDir    :: FilePath
                                 , ghcPackagePath    :: FilePath
                                 , cabalDir          :: FilePath
                                 , virthualEnvBinDir :: FilePath
                                 }

getEnvVar :: String -> IO (Maybe String)
getEnvVar var = Just `fmap` getEnv var `catch` noValueHandler
    where noValueHandler e | isDoesNotExistError e = return Nothing
                           | otherwise             = ioError e

-- check if any virtual env is already active
checkVHE :: IO Bool
checkVHE = do
    virthualEnv <- getEnvVar "VIRTHUALENV"
    case virthualEnv of
        Nothing   -> return False
        Just path -> do
            virthualEnvName <- getEnvVar "VIRTHUALENV_NAME"
            case virthualEnvName of
                Nothing -> do
                       hPutStrLn stderr $
                           "warning: VIRTHUALENV environment variable is defined"
                        ++ ", but no VIRHTUALENV_NAME environment variable defined."
                       putStrLn $ "There is already active Virtual Haskell Environment (at " ++ path ++ ")."
                Just name -> do
                    putStrLn $ "There is already active " ++ name ++ " Virtual Haskell Environment (at " ++ path ++ ")."
            return True

usage :: IO ()
usage = do
    name <- getProgName
    putStrLn $ "usage: " ++ name ++ " ENV_NAME"
    putStrLn ""
    putStrLn "Creates Virtual Haskell Environment in the directory ENV_NAME"

parseArgs :: [String] -> IO (Maybe Options)
parseArgs ["--verbose", name] = return $ Just $ Options True name
parseArgs [name] = return $ Just $ Options False name
parseArgs _ = return Nothing

-- TODO: it should return IO (Maybe String)
-- TODO: it should walk the PATH elems, instead of using system's which util
which :: String -> IO String
which progName = do
  output <- readProcess "which" [progName] ""
  let result = init output -- skip final newline
  return result

prettyVersion :: Version -> String
prettyVersion (Version [] _) = ""
prettyVersion (Version numbers _) = intercalate "." $ map show numbers

prettyPkgInfo :: PackageIdentifier -> String
prettyPkgInfo (PackageIdentifier (PackageName pkgName) (Version [] _)) = pkgName
prettyPkgInfo (PackageIdentifier (PackageName pkgName) version) =
  pkgName ++ "-" ++ prettyVersion version

getDeps :: PackageIdentifier -> MyMonad [PackageIdentifier]
getDeps pkgInfo = do
  debug $ "Extracting dependencies of " ++ prettyPkgInfo pkgInfo
  x <- liftIO $ readProcess "ghc-pkg" ["field", prettyPkgInfo pkgInfo, "depends"] ""
  let trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
      depStrings = tail $ words x
  mapM parsePackageName depStrings

-- transplant a package from simple name (e.g. base)
-- tries to guess the version
transplantPackage :: String -> MyMonad ()
transplantPackage package = do
  debug $ "Copying package " ++ package ++ " to Virtual Haskell Environment."
  debugBlock $ do
    debug $ "Choosing package with highest version number."
    out <- debugBlock $ liftIO $ readProcess "ghc-pkg" ["field", package, "version"] ""
    -- example output:
    -- version: 1.1.4
    -- version: 1.2.0.3
    let versionStrings = map (!!1) $ map words $ lines out
        versions = catMaybes $ map (\s -> parseCheck parse s "version") versionStrings
    debugBlock $ debug $ "Found: " ++ unwords (map prettyVersion versions)
    let version = minimum versions
    debugBlock $ debug $ "Using version: " ++ prettyVersion version
    let pkgInfo = PackageIdentifier (PackageName package) version
    transplantPkg pkgInfo

-- returns environment dictionary used in Virtual Haskell Environment
-- it's inherited from the current process, but variable
-- GHC_PACKAGE_PATH is altered.
getVirtualEnvironment :: MyMonad [(String, String)]
getVirtualEnvironment = do
  env <- liftIO getEnvironment
  dirStructure <- vheDirStructure
  return $ ("GHC_PACKAGE_PATH", ghcPackagePath dirStructure) : filter (\(k,v) -> k /= "GHC_PACKAGE_PATH") env
<commit_msg>use highest version od unversion package request (instead of lowest)<commit_after>{-# LANGUAGE GeneralizedNewtypeDeriving
  #-}
import System.Environment (getEnv, getProgName, getArgs, getEnvironment)
import System.IO (stderr, hPutStrLn, hGetContents, hPutStr, Handle)
import System.IO.Error (isDoesNotExistError)
import System.Exit (exitFailure, ExitCode(..))
import System.Process (readProcess, runInteractiveProcess, waitForProcess, runProcess)
import System.Cmd (rawSystem)
import System.Directory (getCurrentDirectory, createDirectory, executable, getPermissions, setPermissions)
import System.FilePath ((</>))
import Data.List (isPrefixOf, intercalate)
import Control.Monad
import Data.Char (isSpace)
import Distribution.Compat.ReadP
import Distribution.Package
import Distribution.Version
import Distribution.Text
import Data.Maybe(catMaybes)
import Control.Monad.Trans (MonadIO, liftIO)
import Control.Monad.Reader (ReaderT, MonadReader, runReaderT, ask, asks)
import Control.Monad.State (StateT, MonadState, evalStateT, modify, gets)

import Paths_virthualenv (getDataFileName)

data Options = Options { verbose :: Bool
                       , vheName :: String
                       }

data MyState = MyState { logDepth :: Integer
                       }

newtype MyMonad a = MyMonad { unMyMonad :: StateT MyState (ReaderT Options IO) a }
    deriving (Monad, MonadReader Options, MonadIO, MonadState MyState)

runMyMonad :: MyMonad a -> Options -> IO a
runMyMonad m = runReaderT (evalStateT (unMyMonad m) (MyState 0))

debugBlock :: MyMonad a -> MyMonad a
debugBlock m = do
  modify (\s -> s{logDepth = logDepth s + 2})
  result <- m
  modify (\s -> s{logDepth = logDepth s - 2})
  return result

debug :: String -> MyMonad ()
debug s = do
  flag <- asks verbose
  if flag then do
      depth <- gets logDepth
      liftIO $ putStrLn $ replicate (fromInteger depth) ' ' ++ s
   else
      return ()

-- run a process in a Virtual Haskell Environment
-- returns process output and exit status
envProcess :: String -> [String] -> Maybe Handle -> MyMonad (String, ExitCode)
envProcess prog args input = do
  env <- getVirtualEnvironment
  (inp, out, _, pid) <- liftIO $ runInteractiveProcess prog args Nothing (Just env)
  case input of
    Nothing     -> return ()
    Just handle -> liftIO $ hGetContents handle >>= hPutStr inp
  result   <- liftIO $ hGetContents out
  exitCode <- liftIO $ waitForProcess pid
  return (result, exitCode)

data DirStructure = DirStructure { virthualEnv       :: FilePath
                                 , virthualEnvDir    :: FilePath
                                 , ghcPackagePath    :: FilePath
                                 , cabalDir          :: FilePath
                                 , virthualEnvBinDir :: FilePath
                                 }

getEnvVar :: String -> IO (Maybe String)
getEnvVar var = Just `fmap` getEnv var `catch` noValueHandler
    where noValueHandler e | isDoesNotExistError e = return Nothing
                           | otherwise             = ioError e

-- check if any virtual env is already active
checkVHE :: IO Bool
checkVHE = do
    virthualEnv <- getEnvVar "VIRTHUALENV"
    case virthualEnv of
        Nothing   -> return False
        Just path -> do
            virthualEnvName <- getEnvVar "VIRTHUALENV_NAME"
            case virthualEnvName of
                Nothing -> do
                       hPutStrLn stderr $
                           "warning: VIRTHUALENV environment variable is defined"
                        ++ ", but no VIRHTUALENV_NAME environment variable defined."
                       putStrLn $ "There is already active Virtual Haskell Environment (at " ++ path ++ ")."
                Just name -> do
                    putStrLn $ "There is already active " ++ name ++ " Virtual Haskell Environment (at " ++ path ++ ")."
            return True

usage :: IO ()
usage = do
    name <- getProgName
    putStrLn $ "usage: " ++ name ++ " ENV_NAME"
    putStrLn ""
    putStrLn "Creates Virtual Haskell Environment in the directory ENV_NAME"

parseArgs :: [String] -> IO (Maybe Options)
parseArgs ["--verbose", name] = return $ Just $ Options True name
parseArgs [name] = return $ Just $ Options False name
parseArgs _ = return Nothing

-- TODO: it should return IO (Maybe String)
-- TODO: it should walk the PATH elems, instead of using system's which util
which :: String -> IO String
which progName = do
  output <- readProcess "which" [progName] ""
  let result = init output -- skip final newline
  return result

prettyVersion :: Version -> String
prettyVersion (Version [] _) = ""
prettyVersion (Version numbers _) = intercalate "." $ map show numbers

prettyPkgInfo :: PackageIdentifier -> String
prettyPkgInfo (PackageIdentifier (PackageName pkgName) (Version [] _)) = pkgName
prettyPkgInfo (PackageIdentifier (PackageName pkgName) version) =
  pkgName ++ "-" ++ prettyVersion version

getDeps :: PackageIdentifier -> MyMonad [PackageIdentifier]
getDeps pkgInfo = do
  debug $ "Extracting dependencies of " ++ prettyPkgInfo pkgInfo
  x <- liftIO $ readProcess "ghc-pkg" ["field", prettyPkgInfo pkgInfo, "depends"] ""
  let trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
      depStrings = tail $ words x
  mapM parsePackageName depStrings

-- transplant a package from simple name (e.g. base)
-- tries to guess the version
transplantPackage :: String -> MyMonad ()
transplantPackage package = do
  debug $ "Copying package " ++ package ++ " to Virtual Haskell Environment."
  debugBlock $ do
    debug $ "Choosing package with highest version number."
    out <- debugBlock $ liftIO $ readProcess "ghc-pkg" ["field", package, "version"] ""
    -- example output:
    -- version: 1.1.4
    -- version: 1.2.0.3
    let versionStrings = map (!!1) $ map words $ lines out
        versions = catMaybes $ map (\s -> parseCheck parse s "version") versionStrings
    debugBlock $ debug $ "Found: " ++ unwords (map prettyVersion versions)
    let version = maximum versions
    debugBlock $ debug $ "Using version: " ++ prettyVersion version
    let pkgInfo = PackageIdentifier (PackageName package) version
    transplantPkg pkgInfo

-- returns environment dictionary used in Virtual Haskell Environment
-- it's inherited from the current process, but variable
-- GHC_PACKAGE_PATH is altered.
getVirtualEnvironment :: MyMonad [(String, String)]
getVirtualEnvironment = do
  env <- liftIO getEnvironment
  dirStructure <- vheDirStructure
  return $ ("GHC_PACKAGE_PATH", ghcPackagePath dirStructure) : filter (\(k,v) -> k /= "GHC_PACKAGE_PATH") env

{'fraction_non_alphanumeric': 0.0928, 'fraction_numerical': 0.001676190476190476, 'mean_word_length': 2.9488567990373045, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 2, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1822109', 'n_tokens_mistral': 3718, 'n_tokens_neox': 3573, 'n_words': 1255}