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.2.0 +version: 0.1.2.1 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'. diff --git a/resources/Main.elm b/resources/Main.elm --- a/resources/Main.elm +++ b/resources/Main.elm @@ -13,9 +13,3 @@ update action model = case action of Reset -> model - - --- VIEW - -view : Model -> Html -view model = div [] [] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -4,23 +4,14 @@ 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 Control.Arrow as Arrow (first) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Bool (bool) 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) +import Data.Text as Text (Text, append, pack, unpack) import Data.Text.IO as TextIO (getLine, putStrLn) -import Data.Traversable (sequenceA) import Prelude hiding (getLine, putStrLn) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, @@ -28,6 +19,12 @@ import System.Environment (getArgs) import System.FilePath (isValid, takeBaseName, ()) import System.IO (IOMode (WriteMode), withFile) +import Data.Version (Version(..), showVersion, + makeVersion) +import ElmInit (Result, UserDecisions(..), + CmdArgs(..), askChoicesWithOther, + exists, verifyElmVersion, makePackage, + flattenMaybe) standardDirectories :: [FilePath] @@ -55,7 +52,7 @@ ] defaultProjectVersion :: Version -defaultProjectVersion = Version 1 0 0 +defaultProjectVersion = makeVersion [1, 0, 0] defaultElmVersion :: Text defaultElmVersion = "0.15.0 <= v < 0.16.0" @@ -67,167 +64,6 @@ elmConfigName = "elm-package.json" -type Result = Either Text () - - -data CmdArgs = CmdArgs { workingDirectory :: FilePath } - - -data Version = Version { majorVersion :: Int - , minorVersion :: Int - , fineVersion :: Int - } - - -data UserDecisions = Default { projectName :: Text - , sourceFolder :: FilePath - , version :: Version - , summary :: Text - , repository :: Text - , license :: Text - , elmVersion :: Text - } - - -data ElmPackage = ElmPackage { pkgVersion :: Version - , pkgSummary :: Text - , pkgRepository :: Text - , pkgLicense :: Text - , pkgDependencies :: Aeson.Value - , pkgExposedModules :: [Text] - , pkgElmVersion :: Text - , pkgSourceDirs :: [Text] - } - - -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 - , ("source-directories".=). pkgSourceDirs - ] - - -instance Show Version where - showsPrec _ (Version ma mi fi) = - shows ma . showChar '.' . shows mi . showChar '.' . shows fi - - -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] - - -emptyDecisions :: UserDecisions -emptyDecisions = - Default { summary = "" - , repository = "" - , version = Version 0 0 0 - , license = "" - , sourceFolder = "" - , projectName = "" - , elmVersion = "" - } - - -makePackage :: UserDecisions -> ElmPackage -makePackage = ElmPackage - <$> version - <*> summary - <*> repository - <*> license - <*> const (object []) - <*> const [] - <*> elmVersion - <*> (:[]) . pack . sourceFolder - - -enumerate :: Int -> [a] -> [(Int,a)] -enumerate from l = zip [from..(length l)] l - - -getEither :: Read a => a -> IO a -getEither = - catch readLn . handler - where - handler :: a -> IOException -> IO a - handler = const . return - - -askChoices :: Text -> Int -> [Text] -> IO Text -askChoices = - ((fmap <$> (!!) <*>) .) . askChoices' - - -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)) - - 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))) - - -askChoicesWithOther :: Text -> Int -> (Text -> Bool) -> [Text] -> IO Text -askChoicesWithOther m s verifier = - (>>=) - <$> askChoices' m s . (++ ["other (specify)"]) - <*> ((\a -> (<*>) (flip bool getAlternative - <$> return . a) - . (==) ) - <$> (!!) - <*> length) - - 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) - - getCmdArgs :: IO CmdArgs getCmdArgs = fmap CmdArgs @@ -248,11 +84,11 @@ (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 + (error "Project directory does not exist") -- I'm so sorry makeDirs >> return wd) (return wd)) - (error "The chosen directory is a file") -- I'm so sorry + (error "The chosen directory is a file, you'll have to choose a different name") -- I'm so sorry where getResp :: IO Bool @@ -267,33 +103,29 @@ <$> askChoicesWithOther "project name?" 0 - (const True) + (Just) [pack $ takeBaseName wd] - <*> fmap - (unpack) - (askChoicesWithOther - "choose a source folder name" - 0 - (isValid . unpack) -- filepath path verifier - (map pack standardSourceFolders)) - <*> fmap - versionFromString - (askChoicesWithOther - "initial project version?" - 0 - (const True) -- TODO add verifier - [pack $ show defaultProjectVersion]) + <*> askChoicesWithOther + "choose a source folder name" + 0 + ((bool Nothing <$> Just <*> isValid) . unpack) -- filepath path verifier + (map pack standardSourceFolders) + <*> askChoicesWithOther + "initial project version?" + 0 + (verifyElmVersion . unpack) -- TODO add verifier + [pack $ showVersion defaultProjectVersion] <*> (putStrLn "a quick summary" >> getLine) <*> (putStrLn "project repository url" >> getLine) <*> askChoicesWithOther "choose a license" 0 - (const True) + Just availableLicenses <*> askChoicesWithOther "select the elm-version" 0 - (const True) -- add verifier? + (Just) -- add verifier? [defaultElmVersion] @@ -329,8 +161,7 @@ . flip LBS.hPut . encodePretty . makePackage -flattenMaybe :: Maybe (Maybe a) -> Maybe a -flattenMaybe = fromMaybe Nothing + putLicense :: FilePath -> Text -> IO Result putLicense wd =