Commit 17582024 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Merge pull request #506 from gibiansky/limit-dependencies

Get rid of system-filepath
parents e75e4463 0996bef8
{-# LANGUAGE QuasiQuotes, OverloadedStrings, ExtendedDefaultRules, CPP #-} {-# LANGUAGE QuasiQuotes, OverloadedStrings, ExtendedDefaultRules, CPP #-}
-- Keep all the language pragmas here so it can be compiled separately. -- Keep all the language pragmas here so it can be compiled separately.
module Main where module Main where
import Prelude import Prelude
import GHC hiding (Qualified) import GHC hiding (Qualified)
import GHC.Paths import GHC.Paths
import Data.IORef import Data.IORef
import Control.Monad import Control.Monad
import Control.Monad.IO.Class ( MonadIO, liftIO ) import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.List import Data.List
import System.Directory import System.Directory
import Shelly (Sh, shelly, cmd, (</>), toTextIgnore, cd, withTmpDir, mkdir_p, import Shelly (Sh, shelly, cmd, (</>), toTextIgnore, cd, withTmpDir, mkdir_p, touchfile,
touchfile) fromText)
import qualified Data.Text as T
import qualified Shelly import qualified Shelly
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Filesystem.Path.CurrentOS (encodeString) import System.SetEnv (setEnv)
import System.SetEnv (setEnv) import Data.String.Here
import Data.String.Here import Data.String.Utils (strip, replace)
import Data.String.Utils (strip, replace) import Data.Monoid
import Data.Monoid
import IHaskell.Eval.Parser
import IHaskell.Eval.Parser import IHaskell.Types
import IHaskell.Types import IHaskell.IPython
import IHaskell.IPython import IHaskell.Eval.Evaluate as Eval hiding (liftIO)
import IHaskell.Eval.Evaluate as Eval hiding (liftIO)
import qualified IHaskell.Eval.Evaluate as Eval (liftIO) import qualified IHaskell.Eval.Evaluate as Eval (liftIO)
import IHaskell.Eval.Completion import IHaskell.Eval.Completion
import IHaskell.Eval.ParseShell import IHaskell.Eval.ParseShell
import Debug.Trace import Debug.Trace
import Test.Hspec import Test.Hspec
import Test.Hspec.HUnit import Test.Hspec.HUnit
import Test.HUnit (assertBool, assertFailure) import Test.HUnit (assertBool, assertFailure)
traceShowId x = traceShow x x traceShowId x = traceShow x x
...@@ -166,7 +166,7 @@ inDirectory dirs files action = shelly $ withTmpDir $ \dirPath -> ...@@ -166,7 +166,7 @@ inDirectory dirs files action = shelly $ withTmpDir $ \dirPath ->
do cd dirPath do cd dirPath
mapM_ mkdir_p dirs mapM_ mkdir_p dirs
mapM_ touchfile files mapM_ touchfile files
liftIO $ doGhc $ wrap (encodeString dirPath) (action dirPath) liftIO $ doGhc $ wrap (T.unpack $ toTextIgnore dirPath) (action dirPath)
where cdEvent path = liftIO $ setCurrentDirectory path --Eval.evaluate defaultKernelState (":! cd " ++ path) noPublish where cdEvent path = liftIO $ setCurrentDirectory path --Eval.evaluate defaultKernelState (":! cd " ++ path) noPublish
wrap :: FilePath -> Interpreter a -> Interpreter a wrap :: FilePath -> Interpreter a -> Interpreter a
wrap path action = wrap path action =
...@@ -241,8 +241,8 @@ completionTests = do ...@@ -241,8 +241,8 @@ completionTests = do
"import Prel*" `completionHas` ["Prelude"] "import Prel*" `completionHas` ["Prelude"]
it "properly completes haskell file paths on :load directive" $ it "properly completes haskell file paths on :load directive" $
let loading xs = ":load " ++ encodeString xs let loading xs = ":load " ++ T.unpack (toTextIgnore xs)
paths = map encodeString paths = map (T.unpack . toTextIgnore)
in do in do
loading ("dir" </> "file*") `shouldHaveCompletionsInDirectory` paths ["dir" </> "file2.hs", loading ("dir" </> "file*") `shouldHaveCompletionsInDirectory` paths ["dir" </> "file2.hs",
"dir" </> "file2.lhs"] "dir" </> "file2.lhs"]
...@@ -258,7 +258,7 @@ completionTests = do ...@@ -258,7 +258,7 @@ completionTests = do
, "./" </> "file1.lhs"] , "./" </> "file1.lhs"]
it "provides path completions on empty shell cmds " $ it "provides path completions on empty shell cmds " $
":! cd *" `shouldHaveCompletionsInDirectory` map encodeString ["" </> "dir/" ":! cd *" `shouldHaveCompletionsInDirectory` map (T.unpack . toTextIgnore) ["" </> "dir/"
, "" </> "file1.hs" , "" </> "file1.hs"
, "" </> "file1.lhs"] , "" </> "file1.lhs"]
...@@ -268,7 +268,7 @@ completionTests = do ...@@ -268,7 +268,7 @@ completionTests = do
result <- action result <- action
setHomeEvent $ Shelly.fromText home setHomeEvent $ Shelly.fromText home
return result return result
setHomeEvent path = liftIO $ setEnv "HOME" (encodeString path) setHomeEvent path = liftIO $ setEnv "HOME" (T.unpack $ toTextIgnore path)
it "correctly interprets ~ as the environment HOME variable" $ it "correctly interprets ~ as the environment HOME variable" $
let shouldHaveCompletions :: String -> [String] -> IO () let shouldHaveCompletions :: String -> [String] -> IO ()
...@@ -289,7 +289,7 @@ completionTests = do ...@@ -289,7 +289,7 @@ completionTests = do
matchText <- withHsHome $ fst <$> uncurry complete (readCompletePrompt string) matchText <- withHsHome $ fst <$> uncurry complete (readCompletePrompt string)
matchText `shouldBe` expected matchText `shouldBe` expected
setHomeEvent path = liftIO $ setEnv "HOME" (encodeString path) setHomeEvent path = liftIO $ setEnv "HOME" (T.unpack $ toTextIgnore path)
it "generates the correct matchingText on `:! cd ~/*` " $ it "generates the correct matchingText on `:! cd ~/*` " $
do ":! cd ~/*" `shouldHaveMatchingText` ("~/" :: String) do ":! cd ~/*" `shouldHaveMatchingText` ("~/" :: String)
......
...@@ -83,7 +83,6 @@ library ...@@ -83,7 +83,6 @@ library
stm -any, stm -any,
strict >=0.3, strict >=0.3,
system-argv0 -any, system-argv0 -any,
system-filepath -any,
text >=0.11, text >=0.11,
transformers -any, transformers -any,
unix >= 2.6, unix >= 2.6,
...@@ -193,7 +192,6 @@ Test-Suite hspec ...@@ -193,7 +192,6 @@ Test-Suite hspec
stm -any, stm -any,
strict >=0.3, strict >=0.3,
system-argv0 -any, system-argv0 -any,
system-filepath -any,
text >=0.11, text >=0.11,
http-client == 0.4.*, http-client == 0.4.*,
http-client-tls == 0.2.*, http-client-tls == 0.2.*,
......
{-# LANGUAGE NoImplicitPrelude, DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances, GADTs, CPP #-} {-# LANGUAGE NoOverloadedStrings, TypeSynonymInstances, GADTs, CPP #-}
{- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs {- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
a statement, declaration, import, or directive. a statement, declaration, import, or directive.
...@@ -33,7 +33,6 @@ import Data.Dynamic ...@@ -33,7 +33,6 @@ import Data.Dynamic
import Data.Typeable import Data.Typeable
import qualified Data.Serialize as Serialize import qualified Data.Serialize as Serialize
import System.Directory import System.Directory
import Filesystem.Path.CurrentOS (encodeString)
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import System.Posix.IO (createPipe) import System.Posix.IO (createPipe)
#endif #endif
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DoAndIfThenElse #-}
-- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, and -- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, and
-- @console@ commands. -- @console@ commands.
...@@ -23,10 +22,10 @@ import qualified Data.ByteString.Char8 as CBS ...@@ -23,10 +22,10 @@ import qualified Data.ByteString.Char8 as CBS
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import System.Argv0 import System.Argv0
import System.Directory
import qualified Shelly as SH import qualified Shelly as SH
import qualified Filesystem.Path.CurrentOS as FS
import qualified System.IO as IO import qualified System.IO as IO
import qualified System.FilePath as FP
import System.Directory
import Data.List.Utils (split) import Data.List.Utils (split)
import Data.String.Utils (rstrip, endswith, strip, replace) import Data.String.Utils (rstrip, endswith, strip, replace)
import System.Exit (exitFailure) import System.Exit (exitFailure)
...@@ -88,11 +87,11 @@ quietRun path args = SH.runHandles path args handles nothing ...@@ -88,11 +87,11 @@ quietRun path args = SH.runHandles path args handles nothing
handles = [SH.InHandle SH.Inherit, SH.OutHandle SH.CreatePipe, SH.ErrorHandle SH.CreatePipe] handles = [SH.InHandle SH.Inherit, SH.OutHandle SH.CreatePipe, SH.ErrorHandle SH.CreatePipe]
nothing _ _ _ = return () nothing _ _ _ = return ()
fp :: FS.FilePath -> FilePath fp :: SH.FilePath -> FilePath
fp = T.unpack . SH.toTextIgnore fp = T.unpack . SH.toTextIgnore
-- | Create the directory and return it. -- | Create the directory and return it.
ensure :: SH.Sh FS.FilePath -> SH.Sh FS.FilePath ensure :: SH.Sh SH.FilePath -> SH.Sh SH.FilePath
ensure getDir = do ensure getDir = do
dir <- getDir dir <- getDir
SH.mkdir_p dir SH.mkdir_p dir
...@@ -101,13 +100,13 @@ ensure getDir = do ...@@ -101,13 +100,13 @@ ensure getDir = do
-- | Return the data directory for IHaskell. -- | Return the data directory for IHaskell.
ihaskellDir :: SH.Sh FilePath ihaskellDir :: SH.Sh FilePath
ihaskellDir = do ihaskellDir = do
home <- maybe (error "$HOME not defined.") FS.fromText <$> SH.get_env "HOME" home <- maybe (error "$HOME not defined.") SH.fromText <$> SH.get_env "HOME"
fp <$> ensure (return (home SH.</> ".ihaskell")) fp <$> ensure (return (home SH.</> ".ihaskell"))
ipythonDir :: SH.Sh FS.FilePath ipythonDir :: SH.Sh SH.FilePath
ipythonDir = ensure $ (SH.</> "ipython") <$> ihaskellDir ipythonDir = ensure $ (SH.</> "ipython") <$> ihaskellDir
notebookDir :: SH.Sh FS.FilePath notebookDir :: SH.Sh SH.FilePath
notebookDir = ensure $ (SH.</> "notebooks") <$> ihaskellDir notebookDir = ensure $ (SH.</> "notebooks") <$> ihaskellDir
getIHaskellDir :: IO String getIHaskellDir :: IO String
...@@ -180,7 +179,7 @@ installKernelspec replace opts = void $ do ...@@ -180,7 +179,7 @@ installKernelspec replace opts = void $ do
let files = ["kernel.js", "logo-64x64.png"] let files = ["kernel.js", "logo-64x64.png"]
forM_ files $ \file -> do forM_ files $ \file -> do
src <- liftIO $ Paths.getDataFileName $ "html/" ++ file src <- liftIO $ Paths.getDataFileName $ "html/" ++ file
SH.cp (FS.fromText $ T.pack src) (tmp SH.</> kernelName SH.</> file) SH.cp (SH.fromText $ T.pack src) (tmp SH.</> kernelName SH.</> file)
Just ipython <- SH.which "ipython" Just ipython <- SH.which "ipython"
let replaceFlag = ["--replace" | replace] let replaceFlag = ["--replace" | replace]
...@@ -202,9 +201,9 @@ subHome path = SH.shelly $ do ...@@ -202,9 +201,9 @@ subHome path = SH.shelly $ do
-- | Get the path to an executable. If it doensn't exist, fail with an error message complaining -- | Get the path to an executable. If it doensn't exist, fail with an error message complaining
-- about it. -- about it.
path :: Text -> SH.Sh FS.FilePath path :: Text -> SH.Sh SH.FilePath
path exe = do path exe = do
path <- SH.which $ FS.fromText exe path <- SH.which $ SH.fromText exe
case path of case path of
Nothing -> do Nothing -> do
liftIO $ putStrLn $ "Could not find `" ++ T.unpack exe ++ "` executable." liftIO $ putStrLn $ "Could not find `" ++ T.unpack exe ++ "` executable."
...@@ -221,28 +220,34 @@ parseVersion versionStr = ...@@ -221,28 +220,34 @@ parseVersion versionStr =
else Nothing else Nothing
-- | Get the absolute path to this IHaskell executable. -- | Get the absolute path to this IHaskell executable.
getIHaskellPath :: SH.Sh String getIHaskellPath :: SH.Sh FilePath
getIHaskellPath = do getIHaskellPath = do
-- Get the absolute filepath to the argument. -- Get the absolute filepath to the argument.
f <- liftIO getArgv0 f <- T.unpack <$> SH.toTextIgnore <$> liftIO getArgv0
-- If we have an absolute path, that's the IHaskell we're interested in. -- If we have an absolute path, that's the IHaskell we're interested in.
if FS.absolute f if FP.isAbsolute f
then return $ FS.encodeString f then return f
else else
-- Check whether this is a relative path, or just 'IHaskell' with $PATH resolution done by -- Check whether this is a relative path, or just 'IHaskell' with $PATH resolution done by
-- the shell. If it's just 'IHaskell', use the $PATH variable to find where IHaskell lives. -- the shell. If it's just 'IHaskell', use the $PATH variable to find where IHaskell lives.
if FS.filename f == f if FP.takeFileName f == f
then do then do
ihaskellPath <- SH.which "ihaskell" ihaskellPath <- SH.which "ihaskell"
case ihaskellPath of case ihaskellPath of
Nothing -> error "ihaskell not on $PATH and not referenced relative to directory." Nothing -> error "ihaskell not on $PATH and not referenced relative to directory."
Just path -> return $ FS.encodeString path Just path -> return $ T.unpack $ SH.toTextIgnore path
else do else liftIO $ makeAbsolute f
-- If it's actually a relative path, make it absolute. #if !MIN_VERSION_directory(1, 2, 2)
cd <- liftIO getCurrentDirectory -- This is included in later versions of `directory`, but we cannot use later versions because GHC
return $ FS.encodeString $ FS.decodeString cd SH.</> f -- library depends on a particular version of it.
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute = fmap FP.normalise . absolutize
where
absolutize path -- avoid the call to `getCurrentDirectory` if we can
| FP.isRelative path = fmap (FP.</> path) getCurrentDirectory
| otherwise = return path
#endif
getSandboxPackageConf :: IO (Maybe String) getSandboxPackageConf :: IO (Maybe String)
getSandboxPackageConf = SH.shelly $ do getSandboxPackageConf = SH.shelly $ do
myPath <- getIHaskellPath myPath <- getIHaskellPath
...@@ -252,7 +257,7 @@ getSandboxPackageConf = SH.shelly $ do ...@@ -252,7 +257,7 @@ getSandboxPackageConf = SH.shelly $ do
else do else do
let pieces = split "/" myPath let pieces = split "/" myPath
sandboxDir = intercalate "/" $ takeWhile (/= sandboxName) pieces ++ [sandboxName] sandboxDir = intercalate "/" $ takeWhile (/= sandboxName) pieces ++ [sandboxName]
subdirs <- map fp <$> SH.ls (FS.fromText $ T.pack sandboxDir) subdirs <- map fp <$> SH.ls (SH.fromText $ T.pack sandboxDir)
let confdirs = filter (endswith ("packages.conf.d" :: String)) subdirs let confdirs = filter (endswith ("packages.conf.d" :: String)) subdirs
case confdirs of case confdirs of
[] -> return Nothing [] -> return Nothing
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment