Merge pull request #934 from AmpersandTarski/feature/issue932

fix #932

ReleaseNotes.md

@@ -4,6 +4,7 @@
 
 * [Issue #923](https://github.com/AmpersandTarski/Ampersand/issues/923) Lexer error message had disappeared. Now they show again.
 * [Issue #925](https://github.com/AmpersandTarski/Ampersand/issues/925) Add warning when a script contains `BOX <ROWSNH>`, for this is deprecated and could result in an error when a prototype is being generated.
+* [Issue #932](https://github.com/AmpersandTarski/Ampersand/issues/932) `--daemon` now has an optional parameter to tell what config file is used. defaults to `.ampersand`.
 
 ## v3.16.0 (8 april 2019) (few days before scedule)
 

src/Ampersand/Daemon/Daemon/Daemon.hs

@@ -51,7 +51,7 @@ startAmpersandDaemon opts = do
 initialState :: Options -> IO (Either [String] DaemonState)
 initialState opts = do
    curDir <- getCurrentDirectory
-   dotAmpersand <- makeAbsolute $ curDir </> ".ampersand"
+   dotAmpersand <- makeAbsolute $ curDir </> daemonConfig opts
    exists <- doesFileExist dotAmpersand
    if exists 
    then do

src/Ampersand/Misc/Options.hs

@@ -42,6 +42,7 @@ data Options = Options { environment :: EnvironmentOptions
                        , dirCustomizations :: [FilePath] -- the directory that is copied after generating the prototype
                        , allInterfaces :: Bool
                        , runAsDaemon :: Bool -- run Ampersand as a daemon. (for use with the vscode extension)
+                       , daemonConfig :: FilePath -- the path (relative from current directory OR absolute) and filename of a file that contains the root file(s) to be watched by the daemon.
                        , dbName :: String
                        , namespace :: String
                        , testRule :: Maybe String
@@ -226,6 +227,7 @@ getOptions' envOpts =
                       , genPrototype     = False
                       , allInterfaces    = False
                       , runAsDaemon      = False
+                      , daemonConfig     = ".ampersand"
                       , namespace        = ""
                       , testRule         = Nothing
               --        , customCssFile    = Nothing
@@ -443,12 +445,14 @@ options = [ (Option ['v']   ["version"]
                "generate interfaces, which currently does not work."
             , Public)
           , (Option []        ["daemon"]
-               (NoArg (\opts -> opts{runAsDaemon = True}))
-               "Run ampersand as daemon, for use by the vscode ampersand-language-extention."
-            , Hidden)
+               (OptArg (\fn opts -> opts{runAsDaemon = True
+                                        ,daemonConfig = fromMaybe (daemonConfig opts) fn
+                                        })"configfile")
+               "Run ampersand as daemon, for use by the vscode ampersand-language-extention. An optional parameter may be specified to tell what config file is used. This defaults to `.ampersand`."
+            , Public)
           , (Option ['e']     ["export"]
                (OptArg (\mbnm opts -> opts{export2adl = True
-                                                   ,outputfile = fromMaybe "Export.adl" mbnm}) "file")
+                                          ,outputfile = fromMaybe "Export.adl" mbnm}) "file")
                "export as plain Ampersand script, for round-trip testing of the Ampersand compiler."
             , Public)
           , (Option ['o']     ["outputDir"]

src/Ampersand/Prototype/GenFrontend.hs

@@ -462,10 +462,14 @@ downloadPrototypeFramework Options{..} =
     then do
       verboseLn "Emptying folder to deploy prototype framework"
       destroyDestinationDir
+      let url = "https://github.com/AmpersandTarski/Prototype/archive/"++zwolleVersion++".zip"
       verboseLn "Start downloading prototype framework."
-      response <- 
-        parseRequest ("https://github.com/AmpersandTarski/Prototype/archive/"++zwolleVersion++".zip") >>=
-        httpBS  
+      response <- (parseRequest url >>= httpBS) `catch` \err ->  
+                          exitWith . FailedToInstallPrototypeFramework $
+                              [ "Error encountered during deployment of prototype framework:"
+                              , "  Failed to download "<>url
+                              , show (err :: SomeException)
+                              ]
       let archive = removeTopLevelFolder 
                   . toArchive 
                   . BL.fromStrict 
@@ -474,9 +478,20 @@ downloadPrototypeFramework Options{..} =
       let zipoptions = 
               [OptVerbose | verboseP ]
             ++ [OptDestination destination]
-      extractFilesFromArchive zipoptions archive
-      writeFile (destination </> ".frameworkSHA")
-                (show . zComment $ archive)
+      (extractFilesFromArchive zipoptions archive `catch` \err ->  
+                          exitWith . FailedToInstallPrototypeFramework $
+                              [ "Error encountered during deployment of prototype framework:"
+                              , "  Failed to extract the archive found at "<>url
+                              , show (err :: SomeException)
+                              ])
+      let dest = destination </> ".frameworkSHA"  
+      (writeFile dest (show . zComment $ archive) `catch` \err ->  
+                          exitWith . FailedToInstallPrototypeFramework $
+                              [ "Error encountered during deployment of prototype framework:"
+                              , "Archive seems valid: "<>url
+                              , "  Failed to write contents of archive to "<>dest
+                              , show (err :: SomeException)
+                              ])
       return x
     else return x
   ) `catch` \err ->  -- git failed to execute