diff --git a/Licenses.hs b/Licenses.hs --- a/Licenses.hs +++ b/Licenses.hs @@ -8,6 +8,9 @@ module Licenses where +type License = String + +bsd3 :: String -> String -> License bsd3 s y = unlines [ "Copyright " ++ s ++ " " ++ y , "" @@ -41,6 +44,7 @@ , "OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." ] +gplv2 :: License gplv2 = unlines [ " GNU GENERAL PUBLIC LICENSE" , " Version 2, June 1991" @@ -383,6 +387,7 @@ , "Public License instead of this License." ] +gplv3 :: License gplv3 = unlines [ " GNU GENERAL PUBLIC LICENSE" , " Version 3, 29 June 2007" @@ -1061,6 +1066,7 @@ , "" ] +lgpl2 :: License lgpl2 = unlines [ " GNU LIBRARY GENERAL PUBLIC LICENSE" , " Version 2, June 1991" @@ -1545,6 +1551,7 @@ , "That's all there is to it!" ] +lgpl3 :: License lgpl3 = unlines [ " GNU LESSER GENERAL PUBLIC LICENSE" , " Version 3, 29 June 2007" diff --git a/mkcabal.cabal b/mkcabal.cabal --- a/mkcabal.cabal +++ b/mkcabal.cabal @@ -1,5 +1,5 @@ Name: mkcabal -Version: 0.4.1.1 +Version: 0.4.2 License: GPL License-file: LICENSE Homepage: http://code.haskell.org/~dons/code/mkcabal @@ -15,10 +15,10 @@ flag small_base description: Choose the new smaller, split-up base package. - + Executable mkcabal main-is: mkcabal.hs - build-depends: mtl, pcre-light>=0.3, readline + build-depends: mtl, pcre-light>=0.3, readline, extensible-exceptions if flag(small_base) build-depends: base >= 3, pretty, old-locale, old-time, directory diff --git a/mkcabal.hs b/mkcabal.hs --- a/mkcabal.hs +++ b/mkcabal.hs @@ -1,23 +1,23 @@ {-# OPTIONS_GHC -fglasgow-exts #-} -- Pattern guards --- +-- -- Copyright (c) 2006-7 Don Stewart --- +-- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as -- published by the Free Software Foundation; either version 2 of -- the License, or (at your option) any later version. --- +-- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- General Public License for more details. --- +-- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. --- +-- -- -- Create stub files for a new Haskell project, following the rules of: @@ -30,17 +30,17 @@ import System.Time import System.Locale import Control.Monad.Reader -import Control.Exception +import Control.Exception.Extensible import Data.Char import Data.Maybe -import Text.PrettyPrint.HughesPJ +import Text.PrettyPrint.HughesPJ hiding (mode) import Text.Printf import Text.Regex.PCRE.Light.Char8 import Licenses -- -- user-supplied info --- +-- data P = P { project_u :: String , project_lc :: String @@ -52,6 +52,7 @@ -- -- licenses -- +licenses :: [String] licenses = ["GPL2" ,"GPL3" @@ -95,7 +96,7 @@ -- -- A type for a simple cabal file --- +-- data Cabal = Cabal { name :: String , version :: (Int,Int) @@ -123,7 +124,8 @@ ppr :: Cabal -> String ppr c = render $ vcat [ field "name" (name c) - , field "version" ((show.fst.version$ c) +.+ (show.snd.version$ c)) + , field "version" ((show.fst.version$ c) + +.+ (show.snd.version$ c)) , field "synopsis" (description c) , field "description" (description c) , field "category" (category c) @@ -131,7 +133,8 @@ , field "license-file" "LICENSE" , field "author" (author c) , field "maintainer" (email c) - , field "build-Depends" (depends c)] $$ + , field "build-depends" (depends c) + , field "build-type" "Simple"] $$ ( if cabal_type c == Executable then @@ -154,7 +157,8 @@ let mode = case args of [] -> CabalOnly ["--init-project"] -> TheWorks - _ -> error "mkcabal: usage: mkcabal [--init-project]" + _ -> error + "mkcabal: usage: mkcabal [--init-project]" evaluate mode @@ -203,6 +207,7 @@ -- -- Things to do: everything -- +doEverything :: [ReaderT P IO ()] doEverything = [ createDir , createCabal @@ -216,6 +221,7 @@ -- -- Things to do: cabal only -- +doCabalOnly :: [ReaderT P IO ()] doCabalOnly = [ createCabal , createSetup @@ -224,6 +230,7 @@ -- -- create a new directory for this project -- +createDir :: ReaderT P IO () createDir = do dir <- asks directory io $ do createDirectory dir @@ -232,12 +239,14 @@ -- -- create a cabal file, populate it -- +createCabal :: ReaderT P IO () createCabal = do c <- asks cabal_file info <- asks cabal_info io $ do writeFile c (ppr info) -- create a stub src file +createSetup :: ReaderT P IO () createSetup = io $ writeFile "Setup.lhs" setup_hs where setup_hs = @@ -248,6 +257,7 @@ -- -- And create a stub src file -- +createSrc :: ReaderT P IO () createSrc = do f <- asks main_is io $ writeFile f mainsrc @@ -259,6 +269,7 @@ -- -- a stub license file -- +createLicense :: ReaderT P IO () createLicense = do l <- asks (license . cabal_info) w <- asks (author . cabal_info) @@ -288,11 +299,13 @@ -- -- a stub readme file -- +createReadme :: ReaderT P IO () createReadme = io $ writeFile "README" "\n" -- -- print end message -- +done :: ReaderT P IO () done = do dir <- asks directory io $ putStrLn $ "Created new project directory: " ++ dir @@ -300,6 +313,7 @@ -- -- print end message -- +cabalDone :: ReaderT P IO () cabalDone = do file <- asks cabal_file io $ putStrLn $ "Created Setup.lhs and" +++ file @@ -311,11 +325,13 @@ promptStr str options = do x <- readline $ case options of Nothing -> printf "%s: " str - Just (opts, n) -> printf "%s %s [%s]: " str (show opts) (show $ opts !! n) + Just (opts, n) -> printf "%s %s [%s]: " + str (show opts) (show $ opts !! n) case x of Nothing -> error "End of input" - Just [] -> return $ case options of Nothing -> error "prompt returned nothing" - Just (o,i) -> o !! i + Just [] -> return $ case options of + Nothing -> error "prompt returned nothing" + Just (o,i) -> o !! i Just s -> return s -- @@ -325,11 +341,13 @@ prompt str options = do x <- readline $ case options of Nothing -> printf "%s: " str - Just (opts, n) -> printf "%s %s [%s]: " str (show opts) (show $ opts !! n) + Just (opts, n) -> printf "%s %s [%s]: " + str (show opts) (show $ opts !! n) case x of Nothing -> error "End of input" - Just [] -> return $ case options of Nothing -> error "prompt returned nothing" - Just (o,i) -> o !! i + Just [] -> return $ case options of + Nothing -> error "prompt returned nothing" + Just (o,i) -> o !! i Just s -> return (read s) query :: String -> Maybe String -> IO String @@ -347,6 +365,7 @@ -- -- helpers -- +io :: IO a -> ReaderT P IO a io = liftIO infixr 6 +/+, +.+, +++ @@ -372,6 +391,7 @@ -- -- try to check EMAIL and DARCS_EMAIL vars, and user name. -- +queryAuthorNameMail :: IO (String, String) queryAuthorNameMail = do re <- doesFileExist authorRepo if re @@ -381,7 +401,7 @@ he <- doesFileExist authorHome if he then readFile authorHome >>= return . nameAndMail - else handle (\_ -> return $ pair defNameAndMail) $ do + else handleIO (\_ -> return $ pair defNameAndMail) $ do env <- getEnvironment let p | Just e <- lookup "DARCS_EMAIL" env = break (=='<') e | Just e <- lookup "EMAIL" env = (defName, e) @@ -396,4 +416,9 @@ nameAndMail s = pair . maybe defNameAndMail tail $ match (compile "(.*?)[[:space:]]*<(.*)>" []) s [] pair [x,y] = (x,y) + pair _ = undefined + + handleIO :: (Control.Exception.Extensible.IOException -> IO a) + -> IO a -> IO a + handleIO = handle diff --git a/util/lgen.pl b/util/lgen.pl --- a/util/lgen.pl +++ b/util/lgen.pl @@ -31,12 +31,13 @@ open(LICENSE,"<".$ARGV[0]); open(OUTFILE,">>".(defined($ARGV[1]) ? $ARGV[1] : "../Licenses.hs")); +print OUTFILE #ARGV[0]." :: License\n" print OUTFILE $ARGV[0]." = unlines\n ["; $first = ; # print first line seperately since $first =~ s/"/\Q\"\E/g; # it shouldn't be prefixed with a comma chomp($first); print OUTFILE " \"".$first."\"\n "; -while() { chomp; +while() { chomp; $_ =~ s/"/\Q\"\E/g; print OUTFILE ", \"".$_."\"\n "; }