codex 0.1.0.5 → 0.2.0.0
raw patch · 6 files changed
+95/−30 lines, 6 filesdep +machinesdep +machines-directorydep +mono-traversabledep ~codex
Dependencies added: machines, machines-directory, mono-traversable
Dependency ranges changed: codex
Files
- codex.cabal +7/−2
- codex/Main.hs +15/−10
- codex/Main/Config.hs +25/−10
- codex/Main/Config/Codex1.hs +17/−0
- src/Codex.hs +24/−7
- src/Codex/Internal.hs +7/−1
codex.cabal view
@@ -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
codex/Main.hs view
@@ -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 <tagger> Update the `~/.codex` configuration file for the given tagger (hasktags|ctags)."- , " set format <format> Update the `~/.codex` configuration file for the given format (vim|emacs)."+ , " set format <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
codex/Main/Config.hs view
@@ -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
+ codex/Main/Config/Codex1.hs view
@@ -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`."+
src/Codex.hs view
@@ -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
src/Codex/Internal.hs view
@@ -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