diff --git a/codex.cabal b/codex.cabal --- a/codex.cabal +++ b/codex.cabal @@ -1,5 +1,5 @@ name: codex -version: 0.1.0.5 +version: 0.2.0.0 synopsis: A ctags file generator for cabal project dependencies. description: This tool download and cache the source code of packages in your local hackage, @@ -37,12 +37,16 @@ , either >= 4.3.0.1 && < 4.4 , filepath >= 1.3.0.1 && < 1.4 , hackage-db >= 1.8 && < 1.9 + , machines >= 0.2 && < 0.3 + , machines-directory >= 0.0 && < 0.1 , MissingH >= 1.2.1.0 && < 1.3 , process >= 1.1.0.2 && < 1.3 , tar >= 0.4.0.1 && < 0.5 , text >= 1.1.1.3 && < 1.2 , transformers >= 0.3.0.0 && < 0.5 , zlib >= 0.5.4.1 && < 0.6 + -- transitive (but don't compile with 0.4) + , mono-traversable >= 0.6 && < 0.7 executable codex default-language: Haskell2010 @@ -52,6 +56,7 @@ other-modules: Main.Config Main.Config.Codex0 + Main.Config.Codex1 build-depends: base , Cabal @@ -64,4 +69,4 @@ , monad-loops >= 0.4.2 && < 0.5 , transformers , yaml >= 0.8.8.3 && < 0.9 - , codex == 0.1.0.5 + , codex == 0.2.0.0 diff --git a/codex/Main.hs b/codex/Main.hs --- a/codex/Main.hs +++ b/codex/Main.hs @@ -4,6 +4,7 @@ import Control.Monad.Trans.Either hiding (left, right) import Data.Either import Data.Functor +import Data.List import Data.String.Utils import Data.Traversable (traverse) import Distribution.Text @@ -59,20 +60,23 @@ update :: Codex -> Bool -> IO () update cx force = do - (project, dependencies, workspaceProjects) <- resolveCurrentProjectDependencies + (project, dependencies, workspaceProjects') <- resolveCurrentProjectDependencies + projectHash <- computeCurrentProjectHash cx shouldUpdate <- - if (null workspaceProjects) then - either (const True) id <$> (runEitherT $ isUpdateRequired tagsFile dependencies) + if (null workspaceProjects') then + either (const True) id <$> (runEitherT $ isUpdateRequired cx tagsFile dependencies projectHash) else return True if (shouldUpdate || force) then do + let workspaceProjects = if not $ currentProjectIncluded cx then workspaceProjects' + else (WorkspaceProject project ".") : workspaceProjects' fileExist <- doesFileExist tagsFile when fileExist $ removeFile tagsFile putStrLn $ concat ["Updating ", display project] results <- traverse (retrying 3 . runEitherT . getTags) dependencies traverse (putStrLn . show) . concat $ lefts results - res <- runEitherT $ assembly cx dependencies workspaceProjects tagsFile + res <- runEitherT $ assembly cx dependencies projectHash workspaceProjects tagsFile either (putStrLn . show) (const $ return ()) res else putStrLn "Nothing to update." @@ -85,7 +89,7 @@ help :: IO () help = putStrLn $ - unlines [ "Usage: codex [update] [cache clean] [set tagger [hasktags|ctags]] [set format [vim|emacs]]" + unlines [ "Usage: codex [update] [cache clean] [set tagger [hasktags|ctags]] [set format [vim|emacs|sublime]]" , " [--help]" , " [--version]" , "" @@ -93,7 +97,7 @@ , " update --force Discard `codex.tags` file hash and force regeneration" , " cache clean Remove all `tags` file from the local hackage cache]" , " set tagger Update the `~/.codex` configuration file for the given tagger (hasktags|ctags)." - , " set format Update the `~/.codex` configuration file for the given format (vim|emacs)." + , " set format Update the `~/.codex` configuration file for the given format (vim|emacs|sublime)." , "" , "By default `hasktags` will be used, and need to be in the `PATH`, the tagger command can be fully customized in `~/.codex`." , "" @@ -110,11 +114,12 @@ run cx ["set", "tagger", "ctags"] = encodeConfig $ cx { tagsCmd = taggerCmd Ctags } run cx ["set", "tagger", "hasktags"] = encodeConfig $ cx { tagsCmd = taggerCmd Hasktags } run cx ["set", "format", "emacs"] = encodeConfig $ cx { tagsFileHeader = False, tagsFileSorted = False } + run cx ["set", "format", "sublime"] = encodeConfig $ cx { tagsCmd = taggerCmd HasktagsExtended, tagsFileHeader = True, tagsFileSorted = True } run cx ["set", "format", "vim"] = encodeConfig $ cx { tagsFileHeader = True, tagsFileSorted = True } run cx ["--version"] = putStrLn $ concat ["codex: ", display version] run cx ["--help"] = help run cx [] = help - run cx (x:_) = fail $ concat ["codex: '", x,"' is not a codex command. See 'codex --help'."] + run cx args = fail $ concat ["codex: '", intercalate " " args,"' is not a codex command. See 'codex --help'."] withConfig cx f = checkConfig cx >>= \state -> case state of TaggerNotFound -> fail $ "codex: tagger not found." @@ -122,14 +127,14 @@ cacheHash' <- readCacheHash cx case cacheHash' of Just cacheHash -> - when (cacheHash /= configHash) $ do + when (cacheHash /= currentHash) $ do putStrLn "codex: configuration has been updated, cleaning cache ..." cleanCache cx Nothing -> return () res <- f cx - writeCacheHash cx configHash + writeCacheHash cx currentHash return res where - configHash = hashConfig cx + currentHash = codexHash cx fail msg = do putStrLn $ msg diff --git a/codex/Main/Config.hs b/codex/Main/Config.hs --- a/codex/Main/Config.hs +++ b/codex/Main/Config.hs @@ -14,6 +14,7 @@ import Codex import qualified Main.Config.Codex0 as C0 +import qualified Main.Config.Codex1 as C1 import qualified Distribution.Hackage.DB as DB data ConfigState = Ready | TaggerNotFound @@ -36,14 +37,11 @@ where tagger = head $ words (tagsCmd cx) -hashConfig :: Codex -> String -hashConfig cfg = md5s . Str . BS.unpack $ encode cfg - loadConfig :: IO Codex loadConfig = decodeConfig >>= maybe defaultConfig return where defaultConfig = do hp <- DB.hackagePath - let cx = Codex (dropFileName hp) (taggerCmd Hasktags) True True + let cx = Codex True (dropFileName hp) (taggerCmd Hasktags) True True encodeConfig cx return cx @@ -58,21 +56,38 @@ cfg <- config path case cfg of Nothing -> do - cfg0 <- config0 path - case cfg0 of - Nothing -> return Nothing - Just cfg0 -> do + cfg1 <- config1 path + case cfg1 of + Nothing -> do + cfg0 <- config0 path + case cfg0 of + Nothing -> return Nothing + Just cfg0 -> do + encodeConfig cfg + warn + return $ Just cfg + where + cfg = migrate cfg0 + migrate cx = Codex True (C0.hackagePath cx) (C0.tagsCmd cx) True True + Just cfg1 -> do encodeConfig cfg + warn return $ Just cfg where - cfg = migrate cfg0 - migrate cx = Codex (C0.hackagePath cx) (C0.tagsCmd cx) True True + cfg = migrate cfg1 + migrate cx = Codex True (C1.hackagePath cx) (C1.tagsCmd cx) (C1.tagsFileHeader cx) (C1.tagsFileSorted cx) cfg -> return cfg where + warn = do + putStrLn "codex: *warning* your configuration has been migrated automatically!\n" + C1.warn + putStrLn "" config :: FilePath -> IO (Maybe Codex) config = configOf config0 :: FilePath -> IO (Maybe C0.Codex) config0 = configOf + config1 :: FilePath -> IO (Maybe C1.Codex) + config1 = configOf configOf path = do res <- decodeFileEither path return $ eitherToMaybe res diff --git a/codex/Main/Config/Codex1.hs b/codex/Main/Config/Codex1.hs new file mode 100644 --- /dev/null +++ b/codex/Main/Config/Codex1.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveGeneric #-} +module Main.Config.Codex1 where + +import Data.Yaml +import GHC.Generics + +data Codex = Codex { hackagePath :: FilePath, tagsCmd :: String, tagsFileHeader :: Bool, tagsFileSorted :: Bool } + deriving Generic + +instance ToJSON Codex +instance FromJSON Codex + +warn :: IO () +warn = do + putStrLn "\tThe `codex.tags` will now include the tags of the *current* project as well," + putStrLn "\tif that is not the behavior you want, please edit `~/.codex`." + diff --git a/src/Codex.hs b/src/Codex.hs --- a/src/Codex.hs +++ b/src/Codex.hs @@ -5,6 +5,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Either import Data.Hash.MD5 +import Data.Machine import Data.Maybe import Data.Traversable (traverse) import Data.String.Utils hiding (join) @@ -14,6 +15,7 @@ import Distribution.Verbosity import Network.Curl.Download.Lazy import System.Directory +import System.Directory.Machine (files, directoryWalk) import System.FilePath import System.Process @@ -42,12 +44,13 @@ type Action = EitherT String IO -data Tagger = Ctags | Hasktags +data Tagger = Ctags | Hasktags | HasktagsExtended deriving (Eq, Show, Read) taggerCmd :: Tagger -> String taggerCmd Ctags = "ctags --tag-relative=no --recurse -f '$TAGS' '$SOURCES'" taggerCmd Hasktags = "hasktags --ctags --output='$TAGS' '$SOURCES'" +taggerCmd HasktagsExtended = "hasktags --ctags --extendedctag --output='$TAGS' '$SOURCES'" taggerCmdRun :: Codex -> FilePath -> FilePath -> Action FilePath taggerCmdRun cx sources tags = do @@ -62,16 +65,30 @@ res <- liftIO $ (try :: IO a -> IO (Either SomeException a)) io either (left . show) return res +codexHash :: Codex -> String +codexHash cfg = md5s . Str $ show cfg + dependenciesHash :: [PackageIdentifier] -> String dependenciesHash xs = md5s . Str $ xs >>= display -isUpdateRequired :: FilePath -> [PackageIdentifier] -> Action Bool -isUpdateRequired file is = do +tagsFileHash :: Codex -> [PackageIdentifier] -> String -> String +tagsFileHash cx ds projectHash = md5s . Str $ concat [codexHash cx, dependenciesHash ds, projectHash] + +computeCurrentProjectHash :: Codex -> IO String +computeCurrentProjectHash cx = if not $ currentProjectIncluded cx then return "*" else do + xs <- runT $ (autoM getModificationTime) <~ (filtered p)<~ files <~ directoryWalk <~ source ["."] + return . md5s . Str . show $ maximum xs + where + p fp = any (\f -> f fp) (fmap List.isSuffixOf extensions) + extensions = [".hs", ".lhs", ".hsc"] + +isUpdateRequired :: Codex -> FilePath -> [PackageIdentifier] -> String -> Action Bool +isUpdateRequired cx file ds ph = do fileExist <- tryIO $ doesFileExist file if fileExist then do content <- tryIO $ TLIO.readFile file let hash = TextL.toStrict . TextL.drop 17 . head . drop 2 $ TextL.lines content - return $ hash /= (Text.pack $ dependenciesHash is) + return $ hash /= (Text.pack $ tagsFileHash cx ds ph) else return True @@ -104,8 +121,8 @@ sources = packageSources cx i tags = packageTags cx i -assembly :: Codex -> [PackageIdentifier] -> [WorkspaceProject] -> FilePath -> Action FilePath -assembly cx dependencies workspaceProjects o = do +assembly :: Codex -> [PackageIdentifier] -> String -> [WorkspaceProject] -> FilePath -> Action FilePath +assembly cx dependencies projectHash workspaceProjects o = do xs <- fmap (join . maybeToList) $ projects workspaceProjects tryIO $ mergeTags ((fmap tags dependencies) ++ xs) o return o where @@ -125,5 +142,5 @@ headers = if tagsFileHeader cx then fmap TextL.pack [headerFormat, headerSorted, headerHash] else [] headerFormat = "!_TAG_FILE_FORMAT\t2" headerSorted = concat ["!_TAG_FILE_SORTED\t", if sorted then "1" else "0"] - headerHash = concat ["!_TAG_FILE_CODEX\t", dependenciesHash dependencies] + headerHash = concat ["!_TAG_FILE_CODEX\t", tagsFileHash cx dependencies projectHash] sorted = tagsFileSorted cx diff --git a/src/Codex/Internal.hs b/src/Codex/Internal.hs --- a/src/Codex/Internal.hs +++ b/src/Codex/Internal.hs @@ -6,7 +6,13 @@ import Distribution.Verbosity import System.FilePath -data Codex = Codex { hackagePath :: FilePath, tagsCmd :: String, tagsFileHeader :: Bool, tagsFileSorted :: Bool } +data Codex = Codex + { currentProjectIncluded :: Bool + , hackagePath :: FilePath + , tagsCmd :: String + , tagsFileHeader :: Bool + , tagsFileSorted :: Bool } + deriving Show packagePath :: Codex -> PackageIdentifier -> FilePath packagePath cx i = hackagePath cx relativePath i where