diff --git a/Haskintex.hs b/Haskintex.hs --- a/Haskintex.hs +++ b/Haskintex.hs @@ -4,7 +4,7 @@ module Haskintex (haskintex) where -- System -import System.Process (readProcess) +import System.Process (readProcess, readCreateProcess, shell) import System.FilePath import System.Directory import System.IO (hFlush,stdout) @@ -88,6 +88,28 @@ -- Configuration +-- | Possible sources of package DBs. The value of the type is constructed from +-- CLI argument and tells haskintex which strategy to use for package DB selection. +-- +-- If no CLI argument is presented, haskintex tries to guess from local environment +-- which package DB to use. +data PackageDB = + CabalSandboxDB -- ^ Pick package-db from `.cabal-sandbox` folder + | StackDB -- ^ Pick package-db from `stack path` + deriving Show + +-- | True if the input value is cabal sandbox package-db +isCabalSandboxDB :: PackageDB -> Bool +isCabalSandboxDB v = case v of + CabalSandboxDB -> True + _ -> False + +-- | True if the input value is stack package-db +isStackDB :: PackageDB -> Bool +isStackDB v = case v of + StackDB -> True + _ -> False + data Conf = Conf { keepFlag :: Bool , visibleFlag :: Bool @@ -102,6 +124,8 @@ , memocleanFlag :: Bool , autotexyFlag :: Bool , nosandboxFlag :: Bool + , packageDb :: Maybe PackageDB + , werrorFlag :: Bool , unknownFlags :: [String] , inputs :: [FilePath] , memoTree :: MemoTree @@ -122,10 +146,13 @@ , ("memoclean" , memocleanFlag) , ("autotexy" , autotexyFlag) , ("nosandbox" , nosandboxFlag) + , ("cabaldb" , maybe False isCabalSandboxDB . packageDb) + , ("stackdb" , maybe False isStackDB . packageDb) + , ("werror" , werrorFlag) ] readConf :: [String] -> Conf -readConf = go $ Conf False False False False False False False False False False False False False [] [] M.empty +readConf = go $ Conf False False False False False False False False False False False False False Nothing False [] [] M.empty where go c [] = c go c (x:xs) = @@ -146,6 +173,9 @@ "memoclean" -> go (c {memocleanFlag = True}) xs "autotexy" -> go (c {autotexyFlag = True}) xs "nosandbox" -> go (c {nosandboxFlag = True}) xs + "cabaldb" -> go (c {packageDb = Just CabalSandboxDB}) xs + "stackdb" -> go (c {packageDb = Just StackDB}) xs + "werror" -> go (c {werrorFlag = True}) xs _ -> go (c {unknownFlags = unknownFlags c ++ [flag]}) xs -- Otherwise, an input file. _ -> go (c {inputs = inputs c ++ [x]}) xs @@ -207,7 +237,7 @@ auto <- lift $ autotexyFlag <$> get let v = H.Var () . H.UnQual () . H.Ident () f = if auto then H.App () $ if isIO then H.App () (v "fmap") (v "texy") - else v "texy" + else v "texy" else id cons b <$> processExp f (pack h) @@ -273,6 +303,84 @@ -- | A 'MemoTree' maps each expression to its reduced form. type MemoTree = M.Map Text Text +-- | Search in current directory and all parents dirs for given file. +-- Return 'True' if found such file, 'False' either way. Search is performed +-- until root folder is not hit. +doesFileExistsUp :: FilePath -> IO Bool +doesFileExistsUp fname = do + parents <- getAllParents <$> getCurrentDirectory + checks <- mapM (doesFileExist . ( fname)) parents + pure $ or checks + +-- | Generate list of all parents of the given path including the path itself. +getAllParents :: FilePath -> [FilePath] +getAllParents = go . reverse . splitDirectories + where + go [] = [] + go segs = let + parent = joinPath $ reverse segs + in parent : go (drop 1 segs) + +-- | Try to detect cabal sandbox or stack project and get pathes to package DBs. +-- +-- If ambigous situation is presented (both stack and cabal sandbox is found), +-- then fail with descriptive message. +autoDetectSandbox :: Haskintex (Maybe [String]) +autoDetectSandbox = do + noSandbox <- nosandboxFlag <$> get + if noSandbox + then do + outputStr "Ignoring sandbox." + pure Nothing + else do inSandbox <- lift $ doesDirectoryExist ".cabal-sandbox" + hasStackFile <- lift $ doesFileExistsUp "stack.yaml" + case (inSandbox, hasStackFile) of + (True, False) -> do + outputStr "Detected cabal sandbox." + loadCabalSandboxDBPaths + (False, True) -> do + outputStr "Detected stack sandbox." + loadStackDBPaths + (True, True) -> fail $ "Found both cabal sandbox and stack project. Please, specify which package DB to use with either " + ++ " '-cabaldb' or '-stackdb' flags." + (False, False) -> do + outputStr "No sandbox or stack project detected." + pure Nothing + +-- | Generate CLI arguments for GHC for package DB using cabal sandbox +loadCabalSandboxDBPaths :: Haskintex (Maybe [String]) +loadCabalSandboxDBPaths = do + outputStr "Using cabal sandbox for package db" + sand <- lift $ getDirectoryContents ".cabal-sandbox" + let pkgdbs = filter (isSuffixOf "packages.conf.d") sand + case pkgdbs of + pkgdb : _ -> do + outputStr $ "Using sandbox package db: " ++ pkgdb + pure . Just $ [".cabal-sandbox/" ++ pkgdb] + _ -> do + outputStr "Don't use sandbox. Empty .cabal-sandbox" + pure Nothing + +-- | Generate CLI arguments for GHC for package DB using stack environment +loadStackDBPaths :: Haskintex (Maybe [String]) +loadStackDBPaths = do + outputStr "Using stack environment for package db" + let getDBPath s = fmap (filter (/= '\n')) . lift $ readCreateProcess (shell $ "stack path --" ++ s) "" + pkgdbSnapshot <- getDBPath "snapshot-pkg-db" + pkgdbGlobal <- getDBPath "global-pkg-db" + pkgdbLocal <- getDBPath "local-pkg-db" + outputStr $ "Using sandbox package db: \n" ++ unlines [pkgdbSnapshot, pkgdbGlobal, pkgdbLocal] + pure . Just $ [pkgdbSnapshot, pkgdbGlobal, pkgdbLocal] + +-- | Try to detect cabal sandbox and use stack's ones if user specifies the 'stackdb' flag. +getSandbox :: Haskintex (Maybe [String]) +getSandbox = do + pkgDbConf <- packageDb <$> get + case pkgDbConf of + Nothing -> autoDetectSandbox + Just CabalSandboxDB -> loadCabalSandboxDBPaths + Just StackDB -> loadStackDBPaths + memoreduce :: Typeable t => String -- ^ Auxiliar module name -> Bool -- ^ Is this expression memorized? @@ -292,26 +400,16 @@ setTopLevelModules [modName] setImports ["Prelude"] interpret e ty - -- Sandbox recognition - inSandbox <- lift $ doesDirectoryExist ".cabal-sandbox" - r <- if inSandbox - then do outputStr "Sandbox detected." - noSandbox <- nosandboxFlag <$> get - if noSandbox - then do outputStr "Ignoring sandbox." - runInterpreter int - else do sand <- lift $ getDirectoryContents ".cabal-sandbox" - let pkgdbs = filter (isSuffixOf "packages.conf.d") sand - case pkgdbs of - pkgdb : _ -> do - outputStr $ "Using sandbox package db: " ++ pkgdb - unsafeRunInterpreterWithArgs ["-package-db .cabal-sandbox/" ++ pkgdb] int - _ -> runInterpreter int - else runInterpreter int + -- Sandbox recognition and executing interpreter + r <- maybe (runInterpreter int) (\pkgdbs -> unsafeRunInterpreterWithArgs (("-package-db " ++) <$> pkgdbs) int) =<< getSandbox case r of Left err -> do - outputStr $ "Warning: Error while evaluating the expression.\n" + shouldFail <- werrorFlag <$> get + if shouldFail + then fail $ "Error: failed while evaluating the expression: \n" ++ errorString err + else outputStr $ "Warning: Error while evaluating the expression.\n" + ++ errorString err return mempty Right x -> do -- Render result @@ -415,7 +513,7 @@ d <- liftIO $ getAppUserDataDirectory "haskintex" let fp = d "memotree" b <- liftIO $ doesFileExist fp - when b $ do + when b $ do liftIO $ removeFile fp outputStr "Info: memotree removed." @@ -467,7 +565,7 @@ case p of Nothing -> do -- Run GHC externally and read the result. - r <- lift $ pack . init <$> readProcess "ghc" + r <- lift $ pack . init <$> readProcess "ghc" -- Disable reading of .ghci files. [ "-ignore-dot-ghci" -- Evaluation loading the temporal module. @@ -674,7 +772,11 @@ , " expressions in types other than LaTeX and have haskintex to perform" , " the required transformation." , "" - , " -nosandbox Do not use the sandbox package db even in the presence of one." + , " -nosandbox Do not use a sandbox package db even in the presence of one." + , "" + , " -cabaldb Use local cabal sandbox." + , "" + , " -stackdb Use local stackage db." , "" , "Any unsupported flag will be ignored." ] diff --git a/haskintex.cabal b/haskintex.cabal --- a/haskintex.cabal +++ b/haskintex.cabal @@ -1,5 +1,5 @@ name: haskintex -version: 0.7.0.1 +version: 0.8.0.0 synopsis: Haskell Evaluation inside of LaTeX code. description: The /haskintex/ (Haskell in LaTeX) program is a tool that reads a LaTeX file and evaluates Haskell expressions contained