diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2014 tobias pflug + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hoobuddy.cabal b/hoobuddy.cabal new file mode 100644 --- /dev/null +++ b/hoobuddy.cabal @@ -0,0 +1,36 @@ +name: hoobuddy +version: 0.1.0.0 +synopsis: Simple tool for fetching and merging hoogle data +description: + Hoobuddy parses the specified cabal project file and invokes hoogle to fetch databases for + all specified dependencies merging the result into a `default.hoo` file in the current directory. +license: MIT +license-file: LICENSE +author: tobias pflug +maintainer: tobias.pflug@gmail.com +homepage: http://github.com/gilligan/hoobuddy +category: Development +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/gilligan/hoobuddy + +executable hoobuddy + hs-source-dirs: src + main-is: Main.hs + ghc-options: -fwarn-incomplete-patterns + build-depends: base >=4.7 && <4.8 + , Cabal + , directory + , filepath + , monad-loops + , aeson + , yaml + , hoogle >= 4.2.34 + , process + , bytestring + + + default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +import GHC.Generics +import System.Environment (getArgs) +import System.Exit +import Data.Aeson hiding (encode) +import Data.Yaml +import Data.List +import System.Directory (doesFileExist, findExecutable, getCurrentDirectory, getHomeDirectory) +import System.FilePath.Posix +import Hoogle (defaultDatabaseLocation, mergeDatabase) +import Control.Applicative +import Control.Monad (filterM, liftM, unless) +import Data.Maybe (isJust) + +import Hoobuddy +import Data.ByteString.Char8 (unpack) + + +-- TODOs: +-- hoo-4 : use reader monad for config ? + +deriving instance Generic Hoobuddy +instance ToJSON Hoobuddy +instance FromJSON Hoobuddy + + +hoogleMissingError :: String +hoogleMissingError = + unlines [ "Error: hoogle is not installed or not in path" + , "Please install hoogle and run `hoogle data`"] + +defaultPkgs :: [String] +defaultPkgs = words "Cabal.hoo array.hoo base.hoo binary.hoo bytestring.hoo containers.hoo deepseq.hoo directory.hoo filepath.hoo haskell2010.hoo haskell98.hoo hoopl.hoo hpc.hoo old-locale.hoo old-time.hoo pretty.hoo process.hoo template-haskell.hoo time.hoo unix.hoo GLURaw.hoo GLUT.hoo HTTP.hoo HUnit.hoo OpenGL.hoo OpenGLRaw.hoo QuickCheck.hoo async.hoo attoparsec.hoo case-insensitive.hoo cgi.hoo fgl.hoo hashable.hoo haskell-src.hoo html.hoo mtl.hoo network.hoo parallel.hoo parsec.hoo primitive.hoo random.hoo regex-base.hoo regex-compat.hoo regex-posix.hoo split.hoo stm.hoo syb.hoo text.hoo transformers.hoo unordered-containers.hoo vector.hoo xhtml.hoo zlib.hoo" + +help :: IO () +help = putStrLn $ + unlines [ "Usage : hoobuddy [deps|build] " + , " [--help]" + , " [--default]" + , "" + , "deps list configured dependencies" + , "build do stuff yet to be defined" + , "" + , "--default prints the default configuration" + , "--help prints this help" + ] + +main :: IO () +main = do + exitIfHoogleMissing + conf <- loadConfig + args <- getArgs + run conf args where + run _ ["deps", file] = deps file + run conf ["build", file] = build file conf + run _ ["--help"] = help + run _ ["--default"] = defaultConfig >>= \x -> putStrLn $ unpack $ encode x + run _ _ = do + help + exitWith (ExitFailure 1) + +-- | Exits with error code if hoogle isn't installed +exitIfHoogleMissing :: IO () +exitIfHoogleMissing = do + hoogleInstalled <- liftM isJust (findExecutable "hoogle") + unless hoogleInstalled (putStrLn hoogleMissingError >> exitWith (ExitFailure 1)) + + +-- | Loads configuration from file or uses defaults +loadConfig :: IO Hoobuddy +loadConfig = decodeConfig >>= maybe defaultConfig return + +unique :: (Ord a) => [a] -> [a] +unique = map head . group . sort + +defaultConfig :: IO Hoobuddy +defaultConfig = do + location <- defaultDatabaseLocation + return $ Hoobuddy (location "databases") True [] + +-- | Decodes configuration from JSON +decodeConfig :: IO (Maybe Hoobuddy) +decodeConfig = do + homeDir <- getHomeDirectory + parseResult <- decodeFileEither $ homeDir ".hoobuddy.conf" + return $ either (const Nothing) Just parseResult + + +build :: FilePath -> Hoobuddy -> IO () +build cabalFile conf = do + pkgs <- map (++ ".hoo") <$> getDeps cabalFile + dbs <- getHooDatabases (databases conf) + + let allPkgs = (++) pkgs (if useBase conf then defaultPkgs else custom conf) + let available = allPkgs `intersect` dbs + let missing = filter (`notElem` available) allPkgs + + printInfo "Fetching databases for: " missing + hoogleFetch missing >>= \x -> case x of + Right _ -> return () + Left (code, stderr) -> putStrLn ("hoogle exited with error:\n" ++ stderr) >> exitWith code + + putStrLn "Merging databases ..." + currDir <- getCurrentDirectory + existingDbs <- filterM doesFileExist (fmap (databases conf ) allPkgs) + mergeDatabase existingDbs (currDir "default.hoo") + +-- | Pretty printer for info output +printInfo :: String -> [String] -> IO () +printInfo _ [] = return () +printInfo str xs = putStrLn $ str ++ "[" ++ intercalate "," xs ++ "]" + +