nsis 0.2.5 → 0.3

raw patch · 11 files changed

+147/−22 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +7/−0
• Development/NSIS.hs +5/−4
• Development/NSIS/Library.hs +12/−5
• Development/NSIS/Plugins/EnvVarUpdate.hs +2/−2
• Development/NSIS/Plugins/Sections.hs +47/−0
• Development/NSIS/Sugar.hs +19/−4
• Examples/EnvVarUpdate.hs +10/−0
• Examples/Example2.hs +5/−3
• Examples/Radio.hs +33/−0
• Main.hs +4/−3
• nsis.cabal +3/−1

@@ -1,5 +1,12 @@ Changelog for NSIS +0.3+    Make strCheck take a message+    Add a plugin for helping with radio button+    Make constant force an evaluation+    Make section return the section id+    Generalise the type of nsis+    Add a radio button example 0.2.5     Support OName on file 0.2.4

@@ -84,6 +84,7 @@     FileMode(..), SectionFlag(..), ShowWindow(..), FinishOptions(..), DetailsPrint(..)     ) where +import Control.Monad import Development.NSIS.Sugar import Development.NSIS.Show import Development.NSIS.Optimise@@ -91,12 +92,12 @@   -- | Create the contents of an NSIS script from an installer specification.-nsis :: Action () -> String-nsis = unlines . showNSIS . optimise . runAction+nsis :: Action a -> String+nsis = unlines . showNSIS . optimise . runAction . void   -- | Like 'nsis', but don't try and optimise the resulting NSIS script. Useful --   to figure out how the underlying installer works, or if you believe the --   optimisations are introducing bugs (but please do report any such bugs!).-nsisNoOptimise :: Action () -> String-nsisNoOptimise = unlines . showNSIS . runAction+nsisNoOptimise :: Action a -> String+nsisNoOptimise = unlines . showNSIS . runAction . void

@@ -28,12 +28,19 @@                     rest @= strDrop 1 rest)         res --- | Attempt to check that you haven't reached the string limit-strCheck :: Exp String -> Exp String-strCheck x = share x $ \x -> do+-- | NSIS (the underlying installer, not this library) uses fixed length string buffers,+--   defaulting to 1024 bytes. Any strings longer than+--   the limit may cause truncation or segfaults. You can get builds supporting longer strings+--   from <http://nsis.sourceforge.net/Special_Builds>.+--+--   Given @strCheck msg val@, if @val@ exceeds the limit it will 'abort' with @msg@, otherwise+--   it will return 'val'.+strCheck :: Exp String -> Exp String -> Exp String+strCheck msg x = share x $ \x -> do     let special = "@!!_NSIS"-    iff_ (not_ $ special `strIsSuffixOf` (x & special)) $-        abort "String limit exceeded"+    iff_ (not_ $ special `strIsSuffixOf` (x & special)) $ do+        void $ messageBox [MB_ICONSTOP] $ "ERROR: String limit exceeded,\n" & msg+        abort $ "ERROR: String limit exceeded, " & msg     x  

@@ -36,14 +36,14 @@ -- | Set an environment variable by writing to the registry. setEnvVar :: HKEY -> Exp String -> Exp String -> Action () setEnvVar h key val = do-    writeRegExpandStr h (fromString $ resolve h) key (strCheck val)+    writeRegExpandStr h (fromString $ resolve h) key (strCheck ("setting environment variable %" & key & "%") val)     void $ sendMessage [Timeout 5000] hwnd_BROADCAST wm_WININICHANGE (0 :: Exp Int) ("STR:Environment" :: Exp String)   -- | Read a variable from the registry. If you are not modifying the variable --   you should use 'envVar' instead. getEnvVar :: HKEY -> Exp String -> Exp String-getEnvVar h key = strCheck $ readRegStr h (fromString $ resolve h) key+getEnvVar h key = strCheck ("reading environment variable %" & key & "%") $ readRegStr h (fromString $ resolve h) key   -- | Delete the environment variable in the registry.

@@ -0,0 +1,47 @@++-- | Plugin to change how many sections can be selected at once.+module Development.NSIS.Plugins.Sections(atMostOneSection, exactlyOneSection) where++import Control.Monad+import Development.NSIS+++atMostOneSection :: [SectionId] -> Action ()+atMostOneSection xs = do+    selected <- mutableInt_ (-1)+    let ensure = do+            -- find the lowest selected, which isn't already equal to selected+            prev <- constant_ selected+            forM_ (reverse $ zip [0..] xs) $ \(i,x) -> do+                iff_ (prev %/= int i %&& sectionGet x SF_Selected) $ do+                    selected @= int i++            -- ensure only (at most) selected is actually selected+            forM_ (zip [0..] xs) $ \(i,x) -> do+                iff_ (selected %/= int i %&& sectionGet x SF_Selected) $+                    sectionSet x SF_Selected false+    ensure+    onSelChange ensure++exactlyOneSection :: [SectionId] -> Action ()+exactlyOneSection xs = do+    selected <- mutableInt_ (-1)++    let ensure = do+            -- find the lowest selected, which isn't already equal to selected+            prev <- constant_ selected+            forM_ (reverse $ zip [0..] xs) $ \(i,x) ->+                iff_ (prev %/= int i %&& sectionGet x SF_Selected) $+                    selected @= int i+            iff_ (selected %== (-1)) $+                selected @= 0++            -- ensure only selected is actually selected+            forM_ (zip [0..] xs) $ \(i,x) -> do+                let b = selected %== int i+                iff_ (b %/= sectionGet x SF_Selected) $+                    sectionSet x SF_Selected b++    ensure+    onSelChange ensure+

@@ -343,8 +343,21 @@ -- | Create a constant with no name, ensuring the expression is shared. --   Equivalent to @'share' 'return'@. constant_ :: Exp t -> Action (Exp t)-constant_ x = do x <- x; return $ return x+constant_ x = do+    -- either the expression is entirely constant, or has mutable variables inside it+    Value x <- x+    if null [() | Var_{} <- x] then+        -- if it's totally constant, we want to leave it that way so it works in non-eval settings (e.g. file)+        return $ return $ Value x+     else do+        -- if it's mutable, we want to share the value, but also snapshot it so that the mutable variables+        -- don't change afterwards+        v <- var+        return (Value $ val v) @= return (Value x)+        -- add the Literal so that assignment throws an error in future+        return $ return $ Value [Var_ v, Literal ""] + -- | The 'Exp' language is call-by-name, meaning you must use share to avoid evaluating an exression --   multiple times. Using 'share', if the expression has any side effects --   they will be run immediately, but not on subsequent uses. When defining functions operating on@@ -963,13 +976,14 @@         f c (OName x) = do Value x <- x; return c{fileOName=Just x}         f c x = error $ "Invalid attribute to file: " ++ show x -section :: Exp String -> [Attrib] -> Action () -> Action ()+section :: Exp String -> [Attrib] -> Action () -> Action SectionId section name as act = do     sec <- newSectionId     Value name <- name     (xs, _) <- capture $ scope act     x <- foldM f def{secId=sec, secName=name} as     emit $ Section x xs+    return $ secId x     where         f c Unselected = return c{secUnselected=True}         f c Required = return c{secRequired=True}@@ -977,13 +991,14 @@         f c (Id x) = return c{secId=x}         f c x = error $ "Invalid attribute to section: " ++ show x -sectionGroup :: Exp String -> [Attrib] -> Action () -> Action ()+sectionGroup :: Exp String -> [Attrib] -> Action () -> Action SectionId sectionGroup name as act = do     sec <- newSectionId     Value name <- name     (xs, _) <- capture $ scope act     x <- foldM f def{secgId=sec, secgName=name} as     emit $ SectionGroup x xs+    return $ secgId x     where         f c Expanded = return c{secgExpanded=True}         f c (Description x) = do Value x <- x; return c{secgDescription=x}@@ -991,7 +1006,7 @@         f c x = error $ "Invalid attribute to sectionGroup: " ++ show x  uninstall :: Action () -> Action ()-uninstall = section "Uninstall" []+uninstall = void . section "Uninstall" []  -- | Delete file (which can be a file or wildcard, but should be specified with a full path) from the target system. --   If 'RebootOK' is specified and the file cannot be deleted then the file is deleted when the system reboots --

@@ -39,3 +39,13 @@          alert $ "USER $$PATH = " & getEnvVar HKCU "PATH"         alert $ "MACHINE $$PATH = " & getEnvVar HKLM "PATH"++        alert "Expecting to abort with a String limit error"+        deleteEnvVar HKCU "NSIS_TEST"+        val <- mutable_ "This is a test that will overflow at some point"+        i <- mutable_ 0+        while (i %< 100) $ do+           i @= i + 1+           val @= val & val+           setEnvVar HKCU "NSIS_TEST" val+        alert "Failed test, should have got a string limit error"

@@ -15,10 +15,12 @@  example2 = do     -- The name of the installer-    name "Example2"+    _ <- constantStr "Ex" "2" +    name "Example$Ex"+     -- The file to write-    outFile "example2.exe"+    outFile "example$Ex.exe"      -- The default installation directory     installDir "$PROGRAMFILES/Example2"@@ -50,7 +52,7 @@         setOutPath "$INSTDIR"          -- Put file there-        file [] "Examples/Example2.hs"+        file [] "Examples/Example$Ex.hs"          -- Write the installation path into the registry         writeRegStr HKLM "SOFTWARE/NSIS_Example2" "Install_Dir" "$INSTDIR"

@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Examples.Radio(radio) where++import Development.NSIS+import Development.NSIS.Plugins.EnvVarUpdate+import Development.NSIS.Plugins.Sections+++radio = do+    name "Radio"+    outFile "radio.exe"+    installDir "$DESKTOP/Radio"+    requestExecutionLevel User++    -- page Directory+    page Components+    page InstFiles++    section "Core files" [Required] $ do+        setOutPath "$INSTDIR"+        file [] "Examples/Radio.hs"++    local <- section "Add to user %PATH%" [] $ do+        setEnvVarPrepend HKCU "PATH" "$INSTDIR"+    global <- section "Add to system %PATH%" [] $ do+        setEnvVarPrepend HKLM "PATH" "$INSTDIR"+    atMostOneSection [local,global]++    a <- section "I like Marmite" [] $ return ()+    b <- section "I hate Marmite" [] $ return ()+    c <- section "I don't care" [] $ return ()+    exactlyOneSection [a,b,c]

@@ -15,15 +15,16 @@ import Examples.Example2 import Examples.Finish import Examples.Primes+import Examples.Radio import Examples.Taskbar import Examples.WinMessages import Examples.EnvVarUpdate   examples = let (*) = (,) in-    ["example1" * example1, "example2" * example2, "base64" * base64-    ,"finish" * finish, "primes" * primes, "taskbar" * taskbar-    ,"winmessages" * winmessages, "envvarupdate" * envvarupdate]+    ["example1" * void example1, "example2" * void example2, "base64" * void base64+    ,"finish" * void finish, "primes" * void primes, "radio" * void radio, "taskbar" * void taskbar+    ,"winmessages" * void winmessages, "envvarupdate" * void envvarupdate]   main = do

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               nsis-version:            0.2.5+version:            0.3 license:            BSD3 license-file:       LICENSE category:           Development@@ -39,6 +39,7 @@         Development.NSIS.Plugins.Base64         Development.NSIS.Plugins.EnvVarUpdate         Development.NSIS.Plugins.Taskbar+        Development.NSIS.Plugins.Sections         Development.NSIS.Plugins.WinMessages     other-modules:         Development.NSIS.Library@@ -65,5 +66,6 @@         Examples.Example2         Examples.Finish         Examples.Primes+        Examples.Radio         Examples.Taskbar         Examples.WinMessages