elm-init (empty) → 0.1.0.0

raw patch · 4 files changed

+227/−0 lines, 4 filesdep +basedep +bytestringdep +file-embedsetup-changed

Dependencies added: base, bytestring, file-embed, json, system-fileio, system-filepath

Files

LICENSE +20/−0
Setup.hs +2/−0
elm-init.cabal +36/−0
src/Main.hs +169/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 justusadam++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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ elm-init.cabal view

@@ -0,0 +1,36 @@+-- Initial elm-init.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                elm-init+version:             0.1.0.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'.+license:             MIT+license-file:        LICENSE+author:              justusadam+maintainer:          development@justusadam.com+-- copyright:+category:            Development+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++executable elm-init+  main-is:             Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:+      base >=4.5 && <4.9,+      system-fileio >= 0.3,+      system-filepath >= 0.4,+      file-embed >= 0.0.8,+      bytestring >= 0.10,+      -- binary >= 0.7,+      json >= 0.9+  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type: git+  location: git://github.com/JustusAdam/elm-init.git

+ src/Main.hs view

@@ -0,0 +1,169 @@+{-# 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+++type Result = Either String ()+++standardDirectories = map decodeString [+    "elm-stuff"+  ]+++standardFiles = map (Arrow.first decodeString) [+    ("elm-package.json", Just $(embedFile "resources/elm-package.json")),+    ("README.md", Nothing),+    ("LICENSE", Nothing)+  ]+++standardSourceFiles = map (Arrow.first decodeString) [+    ("Main.elm", Just $(embedFile "resources/Main.elm"))+  ]+++{-+  embedding a file as String++  import Data.Binary++  file :: String+  file = decode $(embedFile "filepath")+-}+++sourceFolders = [+    "src",+    "lala"+  ]+++enumerate :: Int -> [a] -> [(Int,a)]+enumerate from l = zip [from..(length l)] l+++askChoices :: String -> Int -> [String] -> IO String+askChoices m s l = askChoices' m s l >>= (\i -> return $ l !! i)+++getEither :: Read a => a -> IO a+getEither x = do+  Control.Exception.catch readLn (handler x)+  where+    handler :: a -> IOException -> IO a+    handler x = const (return x)+++askChoices' :: String -> Int -> [String] -> 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++    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 :: String -> Int -> [String] -> IO String+askChoicesWithOther m s l = do+  i <- askChoices' m s (l ++ ["other (specify)"])+  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+        return s+      else+        getAlternative+++exists :: FilePath -> IO Bool+exists f = do+  isF   <- isFile f+  isDir <- isDirectory f+  return $ isF || isDir+++mkFiles :: [(FilePath, Maybe 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 ()+++mkSourceFiles :: FilePath -> IO [Result]+mkSourceFiles sourceFolder = mkFiles $ map (Arrow.first (sourceFolder </>)) standardSourceFiles+++mkDirs :: FilePath -> [FilePath] -> IO ()+mkDirs wd = mapM_ ( createTree . (wd </>))+++main :: IO ()+main = do++  wd <- getWorkingDirectory++  srcFolder <- fmap ((wd </>).decodeString) (askChoicesWithOther "choose a source folder name" 0 sourceFolders)++  -- putStrLn srcFolder++  mkDirs wd (srcFolder : standardDirectories)+  resStatic <- mkFiles standardFiles++  resSource <- mkSourceFiles srcFolder++  mapM_ (\r ->+      case r of+        Right _       -> return ()+        Left message  -> putStrLn message+    ) (resStatic ++ resSource)