hub 1.4.0 → 1.9.0.1
raw patch · 8 files changed
+104/−21 lines, 8 files
Files
- Hub/CommandLine.hs +13/−8
- Hub/Commands.hs +3/−3
- Hub/Directory.hs +26/−7
- Hub/Directory/Allocate.hs +37/−0
- Hub/SaveLoad.hs +1/−1
- Version.hs +20/−0
- hub.cabal +3/−1
- hub.hs +1/−1
Hub/CommandLine.hs view
@@ -52,7 +52,7 @@ | UnlockCL Hub | PathCL Hub | XmlCL Hub- | InitCL Hub HubName Bool -- -s+ | InitCL Hub HubName Bool Bool -- -s -x (-x => -s) | CommentCL Hub String | CpCL Hub HubName | MvCL Hub HubName@@ -69,7 +69,10 @@ deriving (Show) +data InitType = SetIT | NoSetIT | SandboxIT+ deriving (Show) + prog, hub_dispatch :: [String] -> IO (Maybe CommandLine) prog as =@@ -113,13 +116,15 @@ ["path" ,hn ] -> discover (Just hn) >>= \ hub -> return $ Just $ PathCL hub ["xml" ] -> discover Nothing >>= \ hub -> return $ Just $ XmlCL hub ["xml" ,hn ] -> discover (Just hn) >>= \ hub -> return $ Just $ XmlCL hub- ["init" ] -> hub_uniq Nothing >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True- ["init","-n" ] -> hub_uniq Nothing >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True- ["init","-n" ,hn ] -> hub_uniq (Just hn) >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True- ["init","-s" ,hn' ] -> hub_pair Nothing hn' >>= \ hub -> return $ Just $ InitCL hub hn' True- ["init","-s" ,hn,hn' ] -> hub_pair (Just hn) hn' >>= \ hub -> return $ Just $ InitCL hub hn' True- ["init" ,hn' ] -> hub_pair Nothing hn' >>= \ hub -> return $ Just $ InitCL hub hn' False- ["init" ,hn,hn' ] -> hub_pair (Just hn) hn' >>= \ hub -> return $ Just $ InitCL hub hn' False+ ["init" ] -> hub_uniq Nothing >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True False+ ["init","-n" ] -> hub_uniq Nothing >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True False+ ["init","-n" ,hn ] -> hub_uniq (Just hn) >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True False+ ["init","-s" ,hn' ] -> hub_pair Nothing hn' >>= \ hub -> return $ Just $ InitCL hub hn' True False+ ["init","-s" ,hn,hn' ] -> hub_pair (Just hn) hn' >>= \ hub -> return $ Just $ InitCL hub hn' True False+ ["init","-x" ,hn ] -> hub_uniq (Just hn) >>= \(hub,hn') -> return $ Just $ InitCL hub hn' True True+ ["init","-x" ,hn,hn' ] -> hub_pair (Just hn) hn' >>= \ hub -> return $ Just $ InitCL hub hn' True True+ ["init" ,hn' ] -> hub_pair Nothing hn' >>= \ hub -> return $ Just $ InitCL hub hn' False False+ ["init" ,hn,hn' ] -> hub_pair (Just hn) hn' >>= \ hub -> return $ Just $ InitCL hub hn' False False ["comment" ,cmt ] -> discover Nothing >>= \ hub -> return $ Just $ CommentCL hub cmt ["comment" ,hn,cmt ] -> discover (Just hn) >>= \ hub -> return $ Just $ CommentCL hub cmt ["cp" ,hn' ] -> hub_pair Nothing hn' >>= \ hub -> return $ Just $ CpCL hub hn'
Hub/Commands.hs view
@@ -175,9 +175,9 @@ _xml :: Hub -> IO () _xml hub = readAFile (path__HUB hub) >>= putStr -_init :: Hub -> HubName -> Bool -> IO ()-_init hub0 hn sf =- do hub <- createHub' False hub0 hn sf+_init :: Hub -> HubName -> Bool -> Bool -> IO ()+_init hub0 hn sf xf =+ do hub <- createHub' False hub0 hn sf xf when sf $ _set hub _comment :: Hub -> String -> IO ()
Hub/Directory.hs view
@@ -33,6 +33,7 @@ ) where +import Control.Applicative import qualified Control.Exception as E import Control.Monad import Data.List@@ -185,19 +186,22 @@ prs' _ = Nothing createHub :: Bool -> Hub -> HubName -> IO ()-createHub cp hub0 hn = const () `fmap` createHub' cp hub0 hn False+createHub cp hub0 hn = const () `fmap` createHub' cp hub0 hn False False -createHub' :: Bool -> Hub -> HubName -> Bool -> IO Hub-createHub' cp hub0 hn sf =+createHub' :: Bool -> Hub -> HubName -> Bool -> Bool -> IO Hub+createHub' cp hub0 hn sf xf = do userHubAvailable hn- (h_fp,lib,db) <- user_hub_paths hn+ (h_fp,lib,db0) <- user_hub_paths hn+ db <- case xf of+ True -> sandbox hub0+ False -> return db0 createDirectoryIfMissing True lib case cp of True ->- do db0 <- hub_user_db hub0- cpFileDir db0 db+ do db_ <- hub_user_db hub0+ cpFileDir db_ db False ->- pkg_init hub0 db+ when (not xf) $ pkg_init hub0 db dy <- defaultDirectoryPath let gh = maybe (name__HUB hub0) id $ usr_ghHUB hub0 lk = lockedHUB hub0@@ -474,6 +478,21 @@ home :: IO FilePath home = catchIO (getEnv "HOME") $ \_ -> return "/"++++--+-- Creating a Cabal Sandbox+--++sandbox :: Hub -> IO FilePath+sandbox hub = do+ execP HubO (EE InheritRS InheritRS [] []) FullMDE hub CabalP ["sandbox","init"]+ cwd <- getCurrentDirectory+ dirs <- filter ("ghc" `isInfixOf`) <$> getDirectoryContents ".cabal-sandbox"+ case dirs of+ [dir] -> return $ cwd </> ".cabal-sandbox" </> dir+ _ -> error "no package database located in the sandbox"
+ Hub/Directory/Allocate.hs view
@@ -0,0 +1,37 @@+--+-- >>> Hub.Directory.Allocate <<<+--+-- This module logically belongs to HUb.Directory and would be placed there+-- except doing so would establish an import sysle between Hub.Hub and+-- Hub.Directory through Hub.Parse.+--+-- (c) 2011-2012 Chris Dornan+++module Hub.Directory.Allocate+ ( allocate+ ) where++import qualified Control.Exception as E+import Text.Printf+import System.Directory+import System.Environment+import Hub.System+++-- allocate a library directory from the heap in the (default) directory++allocate :: IO FilePath+allocate =+ do hme <- home+ createDirectoryIfMissing True $ printf "%s/.hubrc/heap" hme+ i <- inc $ printf "%s/.hubrc/heap/counter.txt" hme+ let pth = printf "%s/.hubrc/heap/%d" hme i+ createDirectoryIfMissing True pth+ return pth++home :: IO FilePath+home = catchIO (getEnv "HOME") $ \_ -> return "/"++catchIO :: IO a -> (IOError->IO a) -> IO a+catchIO = E.catch
Hub/SaveLoad.hs view
@@ -64,7 +64,7 @@ _ -> oops HubO mm_msg g_hub <- discover $ Just gh hub <- case mb_hub of- Nothing -> createHub' False g_hub hn False+ Nothing -> createHub' False g_hub hn False False Just hub -> return hub nks0 <- (map iden2nick . Map.keys) `fmap` packageDB hub return $ PD hub (nks0\\nks) (nks\\nks0) nks
+ Version.hs view
@@ -0,0 +1,20 @@+--+-- >>> Version <<<+--+-- Keeper of the version information.+--+-- (c) 2011-2015 Chris Dornan+++module Version+ ( version+ , main+ ) where+++version :: String+version = "1.9.0.1"+++main :: IO ()+main = putStrLn version
hub.cabal view
@@ -1,5 +1,5 @@ Name: hub-Version: 1.4.0+Version: 1.9.0.1 Copyright: Chris Dornan, 2011-2015 Maintainer: Chris Dornan <chris@chrisdornan.com> Author: Chris Dornan <chris@chrisdornan.com>@@ -82,6 +82,7 @@ Hub.Commands Hub.SaveLoad Hub.Directory+ Hub.Directory.Allocate Hub.Discover Hub.FilePaths Hub.Help@@ -93,5 +94,6 @@ Hub.Prog Hub.System Hub.Poss+ Version GHC-options: -Wall Default-language: Haskell2010
hub.hs view
@@ -44,7 +44,7 @@ UnlockCL hub -> _unlock hub PathCL hub -> _path hub XmlCL hub -> _xml hub- InitCL hub hn set -> _init hub hn set+ InitCL hub hn sf xf -> _init hub hn sf xf CommentCL hub cmt -> _comment hub cmt CpCL hub hn -> _cp hub hn MvCL hub hn -> _mv hub hn