diff --git a/elm-init.cabal b/elm-init.cabal --- a/elm-init.cabal +++ b/elm-init.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: elm-init -version: 0.1.0.1 +version: 0.1.1.0 synopsis: Set up basic structure for an elm project description: Initialize a new empty elm project with some basic scaffolding according to 'https://github.com/evancz/elm-architecture-tutorial'. @@ -13,11 +13,16 @@ -- copyright: category: Development build-type: Simple --- extra-source-files: cabal-version: >=1.10 extra-source-files: - resources/elm-package.json, resources/Main.elm + resources/licenses/Apache + resources/licenses/BSD3 + resources/licenses/LGPL2 + resources/licenses/LGPL3 + resources/licenses/MIT + resources/licenses/GPLv3 + resources/licenses/GPLv2 executable elm-init @@ -26,12 +31,14 @@ -- other-extensions: build-depends: base >=4.5 && <4.9, - system-fileio >= 0.3, - system-filepath >= 0.4, + filepath >= 1.4, + directory >= 1.2, file-embed >= 0.0.8, bytestring >= 0.10, - -- binary >= 0.7, - json >= 0.9 + aeson >= 0.8, + aeson-pretty >= 0.7, + text >= 1.2, + containers >= 0.5 hs-source-dirs: src default-language: Haskell2010 diff --git a/resources/elm-package.json b/resources/elm-package.json deleted file mode 100644 --- a/resources/elm-package.json +++ /dev/null @@ -1,15 +0,0 @@ -{ - "version": "1.0.0", - "summary": "helpful summary of your project, less than 80 characters", - "repository": "https://github.com/USER/PROJECT.git", - "license": "BSD3", - "source-directories": [ - "src" - ], - "exposed-modules": [], - "dependencies": { - "elm-lang/core": "2.0.0 <= v < 3.0.0", - "evancz/elm-html": "3.0.0 <= v < 4.0.0" - }, - "elm-version": "0.15.0 <= v < 0.16.0" -} diff --git a/resources/licenses/Apache b/resources/licenses/Apache new file mode 100644 --- /dev/null +++ b/resources/licenses/Apache @@ -0,0 +1,13 @@ +Copyright [year] [name of copyright owner] + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/resources/licenses/BSD3 b/resources/licenses/BSD3 new file mode 100644 --- /dev/null +++ b/resources/licenses/BSD3 @@ -0,0 +1,12 @@ +Copyright (c) [year] [name of copyright owner] +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/resources/licenses/GPLv2 b/resources/licenses/GPLv2 new file mode 100644 --- /dev/null +++ b/resources/licenses/GPLv2 @@ -0,0 +1,15 @@ +Copyright (C) [year] [name of copyright owner] + +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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. diff --git a/resources/licenses/GPLv3 b/resources/licenses/GPLv3 new file mode 100644 --- /dev/null +++ b/resources/licenses/GPLv3 @@ -0,0 +1,14 @@ +Copyright (C) [year] [name of copyright owner] + +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 3 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, see . diff --git a/resources/licenses/LGPL2 b/resources/licenses/LGPL2 new file mode 100644 --- /dev/null +++ b/resources/licenses/LGPL2 @@ -0,0 +1,15 @@ +Copyright (C) [year] [name of copyright owner] + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +This library 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 +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA diff --git a/resources/licenses/LGPL3 b/resources/licenses/LGPL3 new file mode 100644 --- /dev/null +++ b/resources/licenses/LGPL3 @@ -0,0 +1,15 @@ +Copyright (C) [year] [name of copyright owner] + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 3.0 of the License, or (at your option) any later version. + +This library 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 +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA diff --git a/resources/licenses/MIT b/resources/licenses/MIT new file mode 100644 --- /dev/null +++ b/resources/licenses/MIT @@ -0,0 +1,20 @@ +Copyright (c) [year] [name of copyright owner] + +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/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,169 +1,383 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Main (main) where -import Control.Applicative (pure, (<*>)) -import qualified Control.Arrow as Arrow (first) -import Control.Exception (Exception, IOException, catch) -import Data.ByteString as ByteString (ByteString, hPut) -import Data.FileEmbed (embedFile) -import Data.List (intercalate) -import Data.Maybe (fromMaybe) -import Filesystem (createTree, getWorkingDirectory, - isDirectory, isFile) -import Filesystem.Path.CurrentOS as Path -import Prelude hiding (FilePath) -import System.IO (IOMode (WriteMode), withFile) -import qualified Text.JSON as JSON +import Control.Applicative (pure, (<*>)) +import qualified Control.Arrow as Arrow (first) +import Control.Exception (IOException, catch) +import Data.Aeson as Aeson (ToJSON, Value, object, + toJSON, (.=)) +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Bool (bool) +import qualified Data.ByteString as ByteString (ByteString, empty, + hPut, putStrLn) +import qualified Data.ByteString.Lazy as LBS (hPut) +import Data.FileEmbed (embedFile) +import Data.Text as Text (Text, append, intercalate, + pack, splitOn, unpack, toLower) +import Data.Text.IO as TextIO (getLine, putStrLn) +import Data.Traversable (sequenceA) +import Prelude hiding (getLine, putStrLn) +import System.Directory (createDirectoryIfMissing, + doesDirectoryExist, doesFileExist, + getCurrentDirectory, makeAbsolute) +import System.Environment (getArgs) +import System.FilePath (isValid, takeBaseName, ()) +import System.IO (IOMode (WriteMode), withFile) -type Result = Either String () +type Result = Either Text () -standardDirectories = map decodeString [ - "elm-stuff" - ] +data CmdArgs = CmdArgs { workingDirectory :: FilePath } -standardFiles = map (Arrow.first decodeString) [ - ("elm-package.json", Just $(embedFile "resources/elm-package.json")), - ("README.md", Nothing), - ("LICENSE", Nothing) - ] +data Version = Version { majorVersion :: Int + , minorVersion :: Int + , fineVersion :: Int + } -standardSourceFiles = map (Arrow.first decodeString) [ - ("Main.elm", Just $(embedFile "resources/Main.elm")) - ] +data UserDecisions = Default { projectName :: Text + , sourceFolder :: FilePath + , version :: Version + , summary :: Text + , repository :: Text + , license :: Text + , elmVersion :: Text + } -{- - embedding a file as String +data ElmPackage = ElmPackage { pkgVersion :: Version + , pkgSummary :: Text + , pkgRepository :: Text + , pkgLicense :: Text + , pkgDependencies :: Aeson.Value + , pkgExposedModules :: [Text] + , pkgElmVersion :: Text + } - import Data.Binary - file :: String - file = decode $(embedFile "filepath") --} +instance Aeson.ToJSON ElmPackage where + toJSON = object . sequenceA + [ ("version" .=) . show . pkgVersion + , ("summary" .=) . pkgSummary + , ("repository" .=) . pkgRepository + , ("license" .=) . pkgLicense + , ("dependencies" .=) . pkgDependencies + , ("exposed-modules" .=) . pkgExposedModules + , ("elm-version" .=) . pkgElmVersion + ] -sourceFolders = [ - "src", - "lala" +instance Show Version where + showsPrec p (Version ma mi fi) = + shows ma . showChar '.' . shows mi . showChar '.' . shows fi + + +standardDirectories = + [ "elm-stuff" ] + + +standardFiles = + [ ("README.md", Nothing) + , ("LICENSE", Nothing) ] +standardSourceFiles = + [ ("Main.elm", Just $(embedFile "resources/Main.elm")) ] + + +standardLicenses = + [ ("None", ByteString.empty) + , ("BSD3", $(embedFile "resources/licenses/BSD3")) + , ("LGPL3", $(embedFile "resources/licenses/LGPL3")) + , ("LGPL2", $(embedFile "resources/licenses/LGPL2")) + , ("MIT", $(embedFile "resources/licenses/MIT")) + , ("Apache", $(embedFile "resources/licenses/Apache")) + , ("GPLv2", $(embedFile "resources/licenses/GPLv2")) + , ("GPLv3", $(embedFile "resources/licenses/GPLv3")) + ] :: [(Text, ByteString.ByteString)] + + +defaultProjectVersion = Version 1 0 0 + + +defaultElmVersion = "0.15.0 <= v < 0.16.0" + + +defaultLicenses = fst $ unzip standardLicenses + + +sourceFolders = + [ "src" ] + + +elmConfigName = "elm-package.json" :: FilePath + + +makePackage :: UserDecisions -> ElmPackage +makePackage = pure ElmPackage + <*> version + <*> summary + <*> repository + <*> license + <*> const (object []) + <*> const [] + <*> elmVersion + + + +emptyDecisions :: UserDecisions +emptyDecisions = + Default { summary = "" + , repository = "" + , version = Version 1 0 0 + , license = "" + , sourceFolder = "src" + , projectName = "" + , elmVersion = defaultElmVersion + } + + +getUserDecisions :: FilePath -> IO UserDecisions +getUserDecisions wd = + pure Default + <*> askChoicesWithOther + "project name?" + 0 + (const True) + [pack $ takeBaseName wd] + <*> fmap + ((wd ) . unpack) + (askChoicesWithOther + "choose a source folder name" + 0 + (isValid . unpack) -- filepath path verifier + (map pack sourceFolders)) + <*> fmap + versionFromString + (askChoicesWithOther + "initial project version?" + 0 + (const True) -- TODO add verifier + [pack $ show defaultProjectVersion]) + <*> (putStrLn "a quick summary" >> getLine) + <*> (putStrLn "project repository url" >> getLine) + <*> askChoicesWithOther + "choose a license" + 0 + (const True) + defaultLicenses + <*> askChoicesWithOther + "select the elm-version" + 0 + (const True) -- add verifier? + [defaultElmVersion] + + enumerate :: Int -> [a] -> [(Int,a)] enumerate from l = zip [from..(length l)] l -askChoices :: String -> Int -> [String] -> IO String +splitL :: Eq a => a -> [a] -> [[a]] +splitL _ [] = [] +splitL se l = reverse $ foldl (helper se) [[]] l + where + helper :: Eq a => a -> [[a]] -> a -> [[a]] + helper se [] e = helper se [[]] e + helper se acc@(x:xs) e + | se == e = []:acc + | otherwise = (e:x):xs + + +versionFromString :: Text -> Version +versionFromString s + | length sp /= 3 = error "Parse failed" -- I'm so sorry + | otherwise = Version ma mi fi + where + sp@[ma,mi,fi] = map (read.unpack) (splitOn "." s) :: [Int] + + + +askChoices :: Text -> Int -> [Text] -> IO Text askChoices m s l = askChoices' m s l >>= (\i -> return $ l !! i) getEither :: Read a => a -> IO a -getEither x = do +getEither x = Control.Exception.catch readLn (handler x) where handler :: a -> IOException -> IO a - handler x = const (return x) + handler = const . return -askChoices' :: String -> Int -> [String] -> IO Int +askChoices' :: Text -> Int -> [Text] -> IO Int askChoices' message selected choices = do putStrLn message - let (l1, l2) = splitAt selected choices - let (selectedElem : l2tail) = l2 - let out = intercalate "\n" (normFormat 1 l1 ++ (selectedFormat selected selectedElem : normFormat (selected + 1) l2tail)) - ask out where - enumF x = ((show x) ++ " ) ") - enumFn = ((" " ++).enumF) - enumFs = ((" * " ++).enumF) - normFormat f l = map ((uncurry (++)).(Arrow.first enumFn)) $ enumerate f l - selectedFormat x y = ((++ y).enumFs) x + (l1, selectedElem : l2tail) = splitAt selected choices + out = + intercalate + "\n" + (normFormat 1 l1 + ++ (selectedFormat selected selectedElem : normFormat (selected + 1) l2tail)) + enumF x = append (pack $ show x) " ) " + enumFn = append " " . enumF + enumFs = append " * " . enumF + normFormat f = map (uncurry append . Arrow.first enumFn) . enumerate f + selectedFormat x y = (flip append y . enumFs) x + ask out = do putStrLn out -- apparently using putStr here doe not print the full string but -- omits the last line ... buffering? i <- getEither selected - if i <= (length choices) then + if i <= length choices then return i else do putStrLn "invalid choice, please choose again" ask out -askChoicesWithOther :: String -> Int -> [String] -> IO String -askChoicesWithOther m s l = do +askChoicesWithOther :: Text -> Int -> (Text -> Bool) -> [Text] -> IO Text +askChoicesWithOther m s verifier l = do i <- askChoices' m s (l ++ ["other (specify)"]) - if i == (length l) then + if i == length l then getAlternative else return $ l !! i where - verifyValidity = const True getAlternative = do putStrLn "please enter an alternative" + s <- getLine - if verifyValidity s then + if verifier s then return s else + putStrLn "Invalid input, plese enter again" >> getAlternative exists :: FilePath -> IO Bool exists f = do - isF <- isFile f - isDir <- isDirectory f + isF <- doesFileExist f + isDir <- doesDirectoryExist f return $ isF || isDir -mkFiles :: [(FilePath, Maybe ByteString)] -> IO [Result] +mkFiles :: [(FilePath, Maybe ByteString.ByteString)] -> IO [Result] mkFiles = mapM (uncurry mkFile) -mkFile :: FilePath -> Maybe ByteString -> IO Result -mkFile name defaultFile = do - e <- exists name - if e then - return $ Left $ "file " ++ encodeString name ++ " already exists" - else do - System.IO.withFile (encodeString name) WriteMode $ \h -> - maybe (return ()) (ByteString.hPut h) defaultFile - - return $ Right () +mkFile :: FilePath -> Maybe ByteString.ByteString -> IO Result +mkFile name defaultFile = exists name >>= + bool + (withFile + name + System.IO.WriteMode + (\h -> maybe (return ()) (ByteString.hPut h) defaultFile) + >> return (Right ())) + (return $ Left $ "file " `append` pack name `append` " already exists") mkSourceFiles :: FilePath -> IO [Result] -mkSourceFiles sourceFolder = mkFiles $ map (Arrow.first (sourceFolder )) standardSourceFiles +mkSourceFiles sourceFolder = + mkFiles $ map + (Arrow.first (sourceFolder )) + standardSourceFiles mkDirs :: FilePath -> [FilePath] -> IO () -mkDirs wd = mapM_ ( createTree . (wd )) +mkDirs wd = mapM_ (createDirectoryIfMissing True . (wd )) +writeConf :: FilePath -> UserDecisions -> IO () +writeConf wd dec = + withFile + (wd elmConfigName) + WriteMode + (flip LBS.hPut $ encodePretty $ makePackage dec) + + +putLicense :: FilePath -> Text -> IO Result +putLicense wd = + maybe + (return $ Left "License file not found") + (fmap + Right + . withFile + (wd "LICENSE") + WriteMode + . flip ByteString.hPut) + . flip lookup standardLicenses + + +getCmdArgs :: IO CmdArgs +getCmdArgs = + fmap CmdArgs + (getArgs >>= + (\args -> + case args of + [] -> getCurrentDirectory + [x] -> makeAbsolute x + _ -> error "Too many arguments")) -- I'm so sorry + + + +verifyWD :: FilePath -> IO FilePath +verifyWD wd = + doesFileExist wd >>= + bool + (error "The chosen directory is a file") -- I'm so sorry + (doesDirectoryExist wd >>= + bool + (return wd) + (putStrLn "the chosen directory does not exist yet, shall I create it? [y/n]" + >> getResp >>= + (bool + makeDirs + (error "the chosen directory does not exist")) -- I'm so sorry + >> return wd)) + + where + getResp :: IO Bool + getResp = fmap (`elem` ["y", "yes"]) getLine + + makeDirs = createDirectoryIfMissing True wd + + + main :: IO () main = do - wd <- getWorkingDirectory + -- get either the working directory or the directory the user entered + wd <- getCmdArgs >>= (verifyWD . workingDirectory) - srcFolder <- fmap ((wd ).decodeString) (askChoicesWithOther "choose a source folder name" 0 sourceFolders) + -- ask all important input first + decisions <- getUserDecisions wd - -- putStrLn srcFolder + -- create necessary directories + mkDirs wd (sourceFolder decisions : standardDirectories) - mkDirs wd (srcFolder : standardDirectories) - resStatic <- mkFiles standardFiles + -- create non-dynamic files, collect errors + resStatic <- mkFiles $ map (Arrow.first (wd )) standardFiles - resSource <- mkSourceFiles srcFolder + -- create Elm source files, collect errors + resSource <- mkSourceFiles $ wd sourceFolder decisions - mapM_ (\r -> - case r of - Right _ -> return () - Left message -> putStrLn message - ) (resStatic ++ resSource) + -- write the package config based on the user decisions + writeConf wd decisions + + -- write the choosen license + putLicense wd (license decisions) + + -- report all errors + mapM_ (either putStrLn return) (resStatic ++ resSource)