elm-init 0.1.1.1 → 0.1.2.0
raw patch · 2 files changed
+186/−194 lines, 2 files
Files
- elm-init.cabal +3/−1
- src/Main.hs +183/−193
elm-init.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: elm-init-version: 0.1.1.1+version: 0.1.2.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'.@@ -41,6 +41,8 @@ containers >= 0.5 hs-source-dirs: src default-language: Haskell2010+ ghc-options:+ -Wall source-repository head type: git
src/Main.hs view
@@ -3,19 +3,22 @@ module Main (main) where + import Control.Applicative (pure, (<*>)) import qualified Control.Arrow as Arrow (first) import Control.Exception (IOException, catch)+import Control.Monad ((>=>)) 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 as ByteString (ByteString, hPut) import qualified Data.ByteString.Lazy as LBS (hPut) import Data.FileEmbed (embedFile)+import Data.Functor ((<$>))+import Data.Maybe (fromMaybe) import Data.Text as Text (Text, append, intercalate,- pack, splitOn, unpack, toLower)+ pack, splitOn, unpack) import Data.Text.IO as TextIO (getLine, putStrLn) import Data.Traversable (sequenceA) import Prelude hiding (getLine, putStrLn)@@ -27,6 +30,43 @@ import System.IO (IOMode (WriteMode), withFile) +standardDirectories :: [FilePath]+standardDirectories = [ "elm-stuff" ]++standardSourceFolders :: [FilePath]+standardSourceFolders = [ "src" ]++standardFiles :: [(FilePath, Maybe ByteString.ByteString)]+standardFiles = [ ("README.md", Nothing) ]++standardSourceFiles :: [(FilePath, Maybe ByteString.ByteString)]+standardSourceFiles = [ ("Main.elm", Just $(embedFile "resources/Main.elm")) ]++standardLicenses :: [(Text, Maybe ByteString.ByteString)]+standardLicenses =+ [ ("None" , Nothing )+ , ("BSD3" , Just $(embedFile "resources/licenses/BSD3" ))+ , ("LGPL3" , Just $(embedFile "resources/licenses/LGPL3" ))+ , ("LGPL2" , Just $(embedFile "resources/licenses/LGPL2" ))+ , ("MIT" , Just $(embedFile "resources/licenses/MIT" ))+ , ("Apache" , Just $(embedFile "resources/licenses/Apache" ))+ , ("GPLv2" , Just $(embedFile "resources/licenses/GPLv2" ))+ , ("GPLv3" , Just $(embedFile "resources/licenses/GPLv3" ))+ ]++defaultProjectVersion :: Version+defaultProjectVersion = Version 1 0 0++defaultElmVersion :: Text+defaultElmVersion = "0.15.0 <= v < 0.16.0"++availableLicenses :: [Text]+availableLicenses = fst $ unzip standardLicenses++elmConfigName :: FilePath+elmConfigName = "elm-package.json"++ type Result = Either Text () @@ -56,6 +96,7 @@ , pkgDependencies :: Aeson.Value , pkgExposedModules :: [Text] , pkgElmVersion :: Text+ , pkgSourceDirs :: [Text] } @@ -68,95 +109,173 @@ , ("dependencies" .=) . pkgDependencies , ("exposed-modules" .=) . pkgExposedModules , ("elm-version" .=) . pkgElmVersion+ , ("source-directories".=). pkgSourceDirs ] instance Show Version where- showsPrec p (Version ma mi fi) =+ showsPrec _ (Version ma mi fi) = shows ma . showChar '.' . shows mi . showChar '.' . shows fi -standardDirectories =- [ "elm-stuff" ]+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] -standardFiles =- [ ("README.md", Nothing)- , ("LICENSE", Nothing)- ]+emptyDecisions :: UserDecisions+emptyDecisions =+ Default { summary = ""+ , repository = ""+ , version = Version 0 0 0+ , license = ""+ , sourceFolder = ""+ , projectName = ""+ , elmVersion = ""+ } -standardSourceFiles =- [ ("Main.elm", Just $(embedFile "resources/Main.elm")) ]+makePackage :: UserDecisions -> ElmPackage+makePackage = ElmPackage+ <$> version+ <*> summary+ <*> repository+ <*> license+ <*> const (object [])+ <*> const []+ <*> elmVersion+ <*> (:[]) . pack . sourceFolder -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)]+enumerate :: Int -> [a] -> [(Int,a)]+enumerate from l = zip [from..(length l)] l -defaultProjectVersion = Version 1 0 0+getEither :: Read a => a -> IO a+getEither =+ catch readLn . handler+ where+ handler :: a -> IOException -> IO a+ handler = const . return -defaultElmVersion = "0.15.0 <= v < 0.16.0"+askChoices :: Text -> Int -> [Text] -> IO Text+askChoices =+ ((fmap <$> (!!) <*>) .) . askChoices' -defaultLicenses = fst $ unzip standardLicenses+askChoices' :: Text -> Int -> [Text] -> IO Int+askChoices' message selected choices =+ putStrLn message >>+ ask out + where+ (l1, selectedElem : l2tail) = splitAt selected choices+ out =+ intercalate+ "\n"+ (normFormat 1 l1+ ++ (selectedFormat selected selectedElem : normFormat (selected + 1) l2tail)) -sourceFolders =- [ "src" ]+ enumF = flip append " ) " . pack . show+ enumFn = append " " . enumF+ enumFs = append " * " . enumF+ normFormat = (map (uncurry append . Arrow.first enumFn) .) . enumerate+ selectedFormat x y = (flip append y . enumFs) x + ask =+ (>>)+ <$> putStrLn+ <*> (\a ->+ getEither selected >>=+ (bool+ (putStrLn "invalid choice, please choose again" >>+ ask a)+ <$> return+ <*> (<= length choices))) -elmConfigName = "elm-package.json" :: FilePath +askChoicesWithOther :: Text -> Int -> (Text -> Bool) -> [Text] -> IO Text+askChoicesWithOther m s verifier =+ (>>=)+ <$> askChoices' m s . (++ ["other (specify)"])+ <*> ((\a -> (<*>) (flip bool getAlternative+ <$> return . a)+ . (==) )+ <$> (!!)+ <*> length) -makePackage :: UserDecisions -> ElmPackage-makePackage = pure ElmPackage- <*> version- <*> summary- <*> repository- <*> license- <*> const (object [])- <*> const []- <*> elmVersion+ where+ getAlternative =+ putStrLn "please enter an alternative" >>+ getLine >>=+ (bool+ (putStrLn "Invalid input, plese enter again" >>+ getAlternative)+ <$> return+ <*> verifier) +exists :: FilePath -> IO Bool+exists =+ (>>=)+ <$> doesFileExist+ <*> (flip bool+ (return True)+ . doesDirectoryExist) -emptyDecisions :: UserDecisions-emptyDecisions =- Default { summary = ""- , repository = ""- , version = Version 1 0 0- , license = ""- , sourceFolder = "src"- , projectName = ""- , elmVersion = defaultElmVersion- } +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+ (doesDirectoryExist wd >>=+ bool+ (putStrLn "the chosen directory does not exist yet, shall I create it? [y/n]"+ >> getResp >>=+ bool+ (error "the chosen directory does not exist") -- I'm so sorry+ makeDirs+ >> return wd)+ (return wd))+ (error "The chosen directory is a file") -- I'm so sorry++ where+ getResp :: IO Bool+ getResp = flip elem ["y", "yes"] <$> getLine++ makeDirs = createDirectoryIfMissing True wd++ getUserDecisions :: FilePath -> IO UserDecisions getUserDecisions wd =- pure Default- <*> askChoicesWithOther+ Default+ <$> askChoicesWithOther "project name?" 0 (const True) [pack $ takeBaseName wd] <*> fmap- ((wd </>) . unpack)+ (unpack) (askChoicesWithOther "choose a source folder name" 0 (isValid . unpack) -- filepath path verifier- (map pack sourceFolders))+ (map pack standardSourceFolders)) <*> fmap versionFromString (askChoicesWithOther@@ -170,7 +289,7 @@ "choose a license" 0 (const True)- defaultLicenses+ availableLicenses <*> askChoicesWithOther "select the elm-version" 0@@ -178,101 +297,6 @@ [defaultElmVersion] -enumerate :: Int -> [a] -> [(Int,a)]-enumerate from l = zip [from..(length l)] l---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 =- Control.Exception.catch readLn (handler x)- where- handler :: a -> IOException -> IO a- handler = const . return---askChoices' :: Text -> Int -> [Text] -> IO Int-askChoices' message selected choices = do- putStrLn message- ask out-- where- (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- return i- else do- putStrLn "invalid choice, please choose again"- ask out---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- getAlternative- else- return $ l !! i-- where- getAlternative = do- putStrLn "please enter an alternative"-- s <- getLine- if verifier s then- return s- else- putStrLn "Invalid input, plese enter again" >>- getAlternative---exists :: FilePath -> IO Bool-exists f = do- isF <- doesFileExist f- isDir <- doesDirectoryExist f- return $ isF || isDir-- mkFiles :: [(FilePath, Maybe ByteString.ByteString)] -> IO [Result] mkFiles = mapM (uncurry mkFile) @@ -282,31 +306,32 @@ bool (withFile name- System.IO.WriteMode- (\h -> maybe (return ()) (ByteString.hPut h) defaultFile)+ WriteMode+ (flip (maybe (return ())) defaultFile . ByteString.hPut) >> return (Right ())) (return $ Left $ "file " `append` pack name `append` " already exists") mkSourceFiles :: FilePath -> IO [Result]-mkSourceFiles sourceFolder =- mkFiles $ map- (Arrow.first (sourceFolder </>))- standardSourceFiles+mkSourceFiles =+ mkFiles . flip map standardSourceFiles . Arrow.first . (</>) mkDirs :: FilePath -> [FilePath] -> IO ()-mkDirs wd = mapM_ (createDirectoryIfMissing True . (wd </>))+mkDirs = mapM_ . (createDirectoryIfMissing True .) . (</>) writeConf :: FilePath -> UserDecisions -> IO ()-writeConf wd dec =+writeConf wd = withFile (wd </> elmConfigName) WriteMode- (flip LBS.hPut $ encodePretty $ makePackage dec)+ . flip LBS.hPut . encodePretty . makePackage +flattenMaybe :: Maybe (Maybe a) -> Maybe a+flattenMaybe = fromMaybe Nothing+ putLicense :: FilePath -> Text -> IO Result putLicense wd = maybe@@ -317,42 +342,7 @@ (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- (doesDirectoryExist wd >>=- bool- (putStrLn "the chosen directory does not exist yet, shall I create it? [y/n]"- >> getResp >>=- (bool- (error "the chosen directory does not exist") -- I'm so sorry- makeDirs)- >> return wd)- (return wd))- (error "The chosen directory is a file") -- I'm so sorry-- where- getResp :: IO Bool- getResp = fmap (`elem` ["y", "yes"]) getLine-- makeDirs = createDirectoryIfMissing True wd-+ . flattenMaybe . flip lookup standardLicenses main :: IO ()@@ -377,7 +367,7 @@ writeConf wd decisions -- write the choosen license- putLicense wd (license decisions)+ _ <- putLicense wd (license decisions) -- report all errors mapM_ (either putStrLn return) (resStatic ++ resSource)