nsis (empty) → 0.1
raw patch · 13 files changed
+2163/−0 lines, 13 filesdep +basedep +processdep +transformerssetup-changed
Dependencies added: base, process, transformers, uniplate
Files
- Development/NSIS.hs +69/−0
- Development/NSIS/Library.hs +66/−0
- Development/NSIS/Optimise.hs +161/−0
- Development/NSIS/Show.hs +96/−0
- Development/NSIS/Sugar.hs +897/−0
- Development/NSIS/Type.hs +242/−0
- Examples/Example1.hs +44/−0
- Examples/Example2.hs +91/−0
- Examples/Primes.hs +66/−0
- LICENSE +340/−0
- Main.hs +35/−0
- Setup.hs +2/−0
- nsis.cabal +54/−0
+ Development/NSIS.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++-- | NSIS (Nullsoft Scriptable Install System, <http://nsis.sourceforge.net/>) is a tool that allows programmers+-- to create installers for Windows.+-- This library provides an alternative syntax for NSIS scripts, as an embedded Haskell language, removing much+-- of the hard work in developing an install script. Simple NSIS installers should look mostly the same, complex ones should+-- be significantly more maintainable.+--+-- For examples, see the Examples source directory.+--+-- Much of the documentation from the Installer section is taken straight from the NSIS documentation.+module Development.NSIS+ (+ -- * Core types+ nsis, nsisNoOptimise, Action, Exp, Value,+ -- * Scripting+ -- ** Variables+ share, scope, constant, constant_, mutable, mutable_, (@=),+ -- ** Typed variables+ mutableInt, constantInt, mutableInt_, constantInt_, mutableStr, constantStr, mutableStr_, constantStr_,+ -- ** Control Flow+ iff, iff_, while, loop, onError,+ (?), (%&&), (%||),+ Label, newLabel, label, goto,+ -- ** Expressions+ (%==), (%/=), (%<=), (%<), (%>=), (%>),+ true, false, not_,+ strRead, strShow,+ (&), strConcat, strLength, strTake, strDrop, strReplace, strIsPrefixOf, strUnlines,+ -- ** File system manipulation+ FileHandle, fileOpen, fileWrite, fileClose, withFile', writeFile', writeFileLines,+ rmdir, delete, + getFileTime, fileExists, findEach, findOnce,+ createDirectory, createShortcut,+ -- ** Registry manipulation+ readRegStr, deleteRegKey, writeRegStr, writeRegDWORD,+ -- ** Process execution+ exec,+ -- * Installer+ -- ** Global installer options+ name, outFile, installDir, setCompressor,+ installIcon, uninstallIcon, headerImage,+ installDirRegKey, allowRootDirInstall, caption, showInstDetails, showUninstDetails,+ -- ** Sections+ SectionId, section, sectionGroup, newSectionId, sectionSetText, sectionGetText, uninstall, page, unpage,+ -- ** Section commands+ file, alwaysNonFatal, writeUninstaller, alert, setOutPath, messageBox, requestExecutionLevel,+ hideProgress, detailPrint,+ -- * Settings+ Compressor(..), HKEY(..), MessageBoxType(..), Attrib(..), Page(..), Level(..), Visibility(..),+ FileMode(..)+ ) where++import Development.NSIS.Sugar+import Development.NSIS.Show+import Development.NSIS.Optimise+import Development.NSIS.Library+++-- | Create the contents of an NSIS script from an installer specification.+nsis :: Action () -> String+nsis = unlines . showNSIS . optimise . runAction+++-- | 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
+ Development/NSIS/Library.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++module Development.NSIS.Library where++import Development.NSIS.Sugar++-- | Replace one string with another string, in a target string. As some examples:+--+-- > strReplace "t" "XX" "test" %== "XXesXX"+-- > strReplace "ell" "" "hello world" %== "ho world"+strReplace :: Exp String -> Exp String -> Exp String -> Exp String+strReplace from to str = do+ from <- constant_ from+ to <- constant_ to+ str <- constant_ str+ scope $ do+ rest <- mutable "REST" str+ res <- mutable "RES" ""+ while (rest %/= "") $ do+ iff (from `strIsPrefixOf` rest)+ (do+ res @= res & to+ rest @= strDrop (strLength from) rest)+ (do+ res @= res & strTake 1 rest+ rest @= strDrop 1 rest)+ res+++-- | Is the first string a prefix of the second.+strIsPrefixOf :: Exp String -> Exp String -> Exp Bool+strIsPrefixOf x y = share x $ \x -> share y $ \y ->+ strTake (strLength x) y %== strTake (strLength y) x+++-- | Join together a list of strings with @\\r\\n@ after each line. Note that unlike standard 'unlines',+-- we use the Windows convention line separator.+strUnlines :: [Exp String] -> Exp String+strUnlines = strConcat . map (& "\r\n")+++-- | Write a file comprising of a set of lines.+writeFileLines :: Exp FilePath -> [Exp String] -> Action ()+writeFileLines a b = writeFile' a $ strUnlines b+++infixr 3 %&&+infixr 2 %||++-- | Short circuiting boolean operators, equivalent to '&&' and '||' but on 'Exp'.+(%&&), (%||) :: Exp Bool -> Exp Bool -> Exp Bool+(%&&) a b = a ? (b, false)+(%||) a b = a ? (true, b)+++-- | With a 'fileOpen' perform some action, then automatically call 'fileClose'.+-- If the action argument jumps out of the section then the 'fileClose' call will be missed.+withFile' :: FileMode -> Exp FilePath -> (Exp FileHandle -> Action ()) -> Action ()+withFile' mode name act = do+ hdl <- fileOpen mode name+ act hdl+ fileClose hdl++-- | Write a file, like 'writeFile'.+writeFile' :: Exp FilePath -> Exp String -> Action ()+writeFile' name contents = withFile' ModeWrite name $ \hdl -> fileWrite hdl contents
+ Development/NSIS/Optimise.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE PatternGuards #-}++module Development.NSIS.Optimise(optimise) where++import Development.NSIS.Type+import Data.Generics.Uniplate.Data+import Data.List+import Data.Maybe+++-- before: secret = 1021, primes = 109++optimise :: [NSIS] -> [NSIS]+optimise =+ -- allow Label 0+ rep (elimDeadLabel . useLabel0) .+ -- disallow Label 0+ rep (elimDeadLabel . elimAfterGoto . deadAssign . assignSwitch . dullGoto . knownCompare . elimLabeledGoto . elimDeadVar)+++rep :: ([NSIS] -> [NSIS]) -> [NSIS] -> [NSIS]+rep f x = g (measure x) x+ where+ g n1 x1 = if n2 < n1 then g n2 x2 else x2+ where x2 = f $ f $ f $ f x1+ n2 = measure x2+ measure x = length (universeBi x :: [NSIS])+++useLabel0 :: [NSIS] -> [NSIS]+useLabel0 = map (descendBi useLabel0) . f+ where+ f (x:Labeled next:xs)+ | null (children x :: [NSIS]) -- must not be a block with nested instructions+ = descendBi (\i -> if i == next then Label 0 else i) x : Labeled next : f xs+ f (x:xs) = x : f xs+ f [] = []+++-- Label whose next statement is a good, +elimLabeledGoto :: [NSIS] -> [NSIS]+elimLabeledGoto x = transform f x+ where+ f (Labeled x:xs) = Labeled x : xs+ f (x:xs) | null (children x :: [NSIS]) = transformBi moveBounce x : xs+ f x = x++ moveBounce x = fromMaybe x $ lookup x bounce+ bounce = flip concatMap (universe x) $ \x -> case x of+ Labeled x:Goto y:_ -> [(x,y)]+ Labeled x:Labeled y:_ -> [(x,y)]+ _ -> []+++-- Delete variables which are only assigned, never read from+elimDeadVar :: [NSIS] -> [NSIS]+elimDeadVar x = transform f x+ where+ f (Assign x _:xs) | x `elem` unused = xs+ f xs = xs++ unused = nub assign \\ nub used+ used = every \\ assign+ every = universeBi x+ assign = [x | Assign x _ <- universeBi x]++jumpy Goto{} = True+jumpy StrCmpS{} = True+jumpy IntCmp{} = True+jumpy IfErrors{} = True+jumpy IfFileExists{} = True+jumpy MessageBox{} = True+jumpy _ = False+++-- Eliminate any code after a goto, until a label+elimAfterGoto :: [NSIS] -> [NSIS]+elimAfterGoto x = transformBi f x+ where+ f (x:xs) | jumpy x = x : g xs+ f x = x++ g (Labeled x:xs) = Labeled x:xs+ g (x:xs) = g xs+ g x = x+++-- Be careful to neither introduce or remove label based errors+elimDeadLabel :: [NSIS] -> [NSIS]+elimDeadLabel x = transform f x+ where+ f (Labeled x:xs) | x `elem` unused = xs+ f xs = xs++ unused = nub label \\ nub gotos+ gotos = every \\ label+ every = universeBi x+ label = [x | Labeled x <- universeBi x]+++dullGoto :: [NSIS] -> [NSIS]+dullGoto = transform f+ where+ f (Goto l1:Labeled l2:xs) | l1 == l2 = Labeled l2 : xs+ f x = x+++-- A tricky one! Comparison after jump+knownCompare :: [NSIS] -> [NSIS]+knownCompare x = transform f x+ where+ f (Assign var val : StrCmpS a b yes no : xs)+ | a == [Var_ var], Just eq <- isEqual b val+ = Assign var val : Goto (if eq then yes else no) : xs++ -- grows, but only a finite amount+ f (Assign var val : Labeled l : StrCmpS a b yes no : xs)+ | a == [Var_ var], Just eq <- isEqual b val+ = Assign var val : Goto (if eq then yes else no) : Labeled l : StrCmpS a b yes no : xs++ f (Assign var val : c : xs) | jumpy c = Assign var val : transformBi g c : xs+ where+ g l | Just (StrCmpS a b yes no) <- lookup l cmps+ , a == [Var_ var], Just eq <- isEqual b val+ = if eq then yes else no+ g l = l+ f x = x++ cmps = [(l,cmp) | Labeled l : cmp@StrCmpS{} : _ <- universeBi x]+++isEqual :: Val -> Val -> Maybe Bool+isEqual x y | x == y = Just True+ | isLit x, isLit y = Just False+ | otherwise = Nothing+ where+ isLit = all isLiteral+ isLiteral Literal{} = True+ isLiteral _ = False+++assignSwitch :: [NSIS] -> [NSIS]+assignSwitch = transform f+ where+ -- this rule just switches the assignment, back and forth, ad infinitum+ -- not very principled!+ f (IntOp out1 a b c : Assign other ([Var_ out2]) : xs)+ | out1 == out2+ = IntOp other a b c : Assign out1 ([Var_ other]) : xs+ f x = x+++deadAssign :: [NSIS] -> [NSIS]+deadAssign = transform f+ where+ f (Assign v x:xs) | isDead v xs = xs+ f xs = xs++ isDead v (Labeled _:xs) = isDead v xs+ isDead v (Assign v2 x:xs) = v `notElem` universeBi x && (v == v2 || isDead v xs)+ isDead v _ = False
+ Development/NSIS/Show.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE RecordWildCards #-}++module Development.NSIS.Show(showNSIS) where++import Development.NSIS.Type+import Data.Generics.Uniplate.Data+import Data.Char+import Data.List+++showNSIS :: [NSIS] -> [String]+showNSIS xs =+ ["!Include MUI2.nsh"] +++ ["Var _" ++ show v | v <- sort $ nub [i | Var i <- universeBi xs]] +++ outs (filter isGlobal xs) +++ ["!insertmacro MUI_LANGUAGE \"English\""] +++ concat [("Function " ++ show name) : map indent (outs body) ++ ["FunctionEnd"] | Function name body <- universeBi xs] +++ outs (filter isSection xs) +++ ["Function .onInit" | not $ null inits] +++ map indent (outs inits) +++ ["FunctionEnd" | not $ null inits] +++ (if null descs then [] else+ ["!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN"] +++ map indent ["!insertmacro MUI_DESCRIPTION_TEXT " ++ show i ++ " " ++ show d | (i,d) <- descs] +++ ["!insertmacro MUI_FUNCTION_DESCRIPTION_END"])+ where descs = filter (not . null . snd) $ concatMap secDescs $ universeBi xs+ inits = filter (\x -> not (isSection x) && not (isGlobal x)) xs+++secDescs :: NSIS -> [(SectionId, Val)]+secDescs (Section x _) = [(secId x, secDescription x)]+secDescs (SectionGroup x _) = [(secgId x, secgDescription x)]+secDescs _ = []+++isGlobal :: NSIS -> Bool+isGlobal x = case x of+ Name{} -> True+ OutFile{} -> True+ InstallDir{} -> True+ SetCompressor{} -> True+ InstallIcon{} -> True+ UninstallIcon{} -> True+ HeaderImage{} -> True+ Page{} -> True+ Unpage{} -> True+ RequestExecutionLevel{} -> True+ InstallDirRegKey{} -> True+ AllowRootDirInstall{} -> True+ ShowInstDetails{} -> True+ ShowUninstDetails{} -> True+ Caption{} -> True+ _ -> False++isSection :: NSIS -> Bool+isSection x = case x of+ Section{} -> True+ SectionGroup{} -> True+ _ -> False+++outs :: [NSIS] -> [String]+outs = concatMap out++out :: NSIS -> [String]+out (Assign v x) = ["StrCpy " ++ show v ++ " " ++ show x]+out (SetCompressor ACompressor{..}) = [unwords $ "SetCompressor" : ["/solid"|compSolid] ++ ["/final"|compFinal] ++ [map toLower $ show compType]]+out (Section ASection{secId=SectionId secId, ..} xs) =+ [unwords $ "Section" : ["/o"|secUnselected] ++ [show $ [Literal "!"|secBold] ++ secName, "_sec" ++ show secId]] +++ map indent (["SectionIn RO" | secRequired] ++ outs xs) +++ ["SectionEnd"]+out (SectionGroup ASectionGroup{secgId=SectionId secgId, ..} xs) =+ [unwords $ "SectionGroup" : ["/e"|secgExpanded] ++ [show secgName, "_sec" ++ show secgId]] +++ map indent (outs xs) +++ ["SectionGroupEnd"]+out (File AFile{..}) = [unwords $ "File" : ["/nonfatal"|fileNonFatal] ++ ["/r"|fileRecursive] ++ [show filePath]]+out (Labeled i) = [show i ++ ":"]+out (CreateShortcut AShortcut{..}) = return $ unwords $+ ["CreateShortcut", show scFile, show scTarget, show scParameters, show scIconFile+ ,show scIconIndex, show scStartOptions, show scKeyboardShortcut, show scDescription]+out (InstallIcon x) = ["!define MUI_ICON " ++ show x]+out (UninstallIcon x) = ["!define MUI_UNICON " ++ show x]+out (HeaderImage x) = "!define MUI_HEADERIMAGE" : ["!define MUI_HEADERIMAGE_BITMAP " ++ show x | Just x <- [x]]+out (Page x) = ["!insertmacro MUI_PAGE_" ++ map toUpper (show x)]+out (Unpage x) = ["!insertmacro MUI_UNPAGE_" ++ map toUpper (show x)]+out Function{} = []+out (Delete ADelete{..}) = [unwords $ "Delete" : ["/rebootok"|delRebootOK] ++ [show delFile]]+out (RMDir ARMDir{..}) = [unwords $ "RMDir" : ["/r"|rmRecursive] ++ ["/rebootok"|rmRebootOK] ++ [show rmDir]]+out (MessageBox flags txt lbls) = [unwords $ "MessageBox" : intercalate "|" (map show flags) : show txt :+ ["ID" ++ a ++ " " ++ show b | (a,b) <- lbls]]+out (Goto x) = ["Goto " ++ show x | x /= Label 0]++out x = [show x]+++indent x = " " ++ x
+ Development/NSIS/Sugar.hs view
@@ -0,0 +1,897 @@+{-# LANGUAGE OverloadedStrings, EmptyDataDecls, ScopedTypeVariables, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}++module Development.NSIS.Sugar(+ Compressor(..), HKEY(..), MessageBoxType(..), Page(..), Level(..), Visibility(..), FileMode(..),+ module Development.NSIS.Sugar, Label, SectionId+ ) where++import Development.NSIS.Type+import Data.Char+import Data.List+import Data.Maybe+import Data.Monoid+import Data.String+import Data.Typeable+import Control.Monad+import Control.Monad.Trans.State+import Data.Generics.Uniplate.Data+++---------------------------------------------------------------------+-- INTERNALS++data S = S+ {uniques :: Int+ ,stream :: [NSIS]+ ,scopes :: [[(String,(TypeRep,Val))]] -- nearest scope is here+ }++-- | Monad in which installers are defined. A useful command to start with is 'section'.+newtype Action a = Action (State S a)+ deriving (Functor, Monad)+++-- | A 'Value', only used by 'Exp', which can be produced using 'return'.+-- The @ty@ argument should be one of 'String', 'Int' or 'Bool'.+newtype Value ty = Value {fromValue :: Val}++tyString = typeOf (undefined :: String)+tyInt = typeOf (undefined :: Int)+++unique :: Action Int+unique = Action $ do+ s <- get+ put s{uniques = uniques s + 1}+ return $ uniques s++var :: Action Var+var = fmap Var unique++newSectionId :: Action SectionId+newSectionId = fmap SectionId unique++val x = [Var_ x]+lit x = [Literal x | x /= ""]++-- | Create a new label, used with 'goto' and 'label' to write line jump based programming.+-- Where possible you should use structured alternatives, such as 'iff', 'while' and 'loop'.+-- Each created label must be used with one call to 'label', and any number of calls to+-- 'goto'. As an example:+--+-- @+-- abort <- 'newLabel'+-- 'while' var $ do+-- 'iff_' cond1 $ 'goto' abort+-- 'iff_' cond2 $ 'goto' abort+-- var '@=' 'strDrop' 1 var +-- 'label' abort+-- @+--+-- Note that the above example could have been written in a simpler manner with 'loop'.+newLabel :: Action Label+newLabel = fmap Label unique++emit :: NSIS -> Action ()+emit x = Action $ modify $ \s -> s{stream = stream s ++ [x]}+++rval :: Exp a -> Action Var+rval act = do+ (xs, res) <- capture act+ case res of+ _ | not $ null xs -> error $ "An R-value may not emit any statements: " ++ show xs+ Value [Var_ x] -> return x+ _ -> error $ "An R-value must be a single value, found: " ++ show (fromValue res)+++capture :: Action a -> Action ([NSIS], a)+capture (Action act) = Action $ do+ s0 <- get+ put s0{stream=[]}+ res <- act+ s1 <- get+ put s1{stream=stream s0}+ return (stream s1, res)++runAction :: Action () -> [NSIS]+runAction (Action act) = stream $ execState act s0+ where s0 = S 1 [] [("NSISDIR",(tyString,[Builtin "{NSISDIR}"])):[(x, (tyString, [Builtin x])) | x <- builtin]]+++builtin = words $+ "ADMINTOOLS APPDATA CDBURN_AREA CMDLINE COMMONFILES COMMONFILES32 COMMONFILES64 COOKIES DESKTOP DOCUMENTS " +++ "EXEDIR EXEFILE EXEPATH FAVORITES FONTS HISTORY HWNDPARENT INSTDIR INTERNET_CACHE LANGUAGE LOCALAPPDATA " +++ "MUSIC NETHOOD OUTDIR PICTURES PLUGINSDIR PRINTHOOD PROFILE PROGRAMFILES PROGRAMFILES32 PROGRAMFILES64 " +++ "QUICKLAUNCH RECENT RESOURCES RESOURCES_LOCALIZED SENDTO SMPROGRAMS SMSTARTUP STARTMENU SYSDIR TEMP " +++ "TEMPLATES VIDEOS WINDIR"+++alwaysNonFatal :: Action () -> Action ()+alwaysNonFatal act = do+ (xs, _) <- capture act+ mapM_ emit $ transformBi f xs+ where+ f (File x) = File x{fileNonFatal=True}+ f x = x+++-- | The type of expressions - namely an 'Action' producing a 'Value'. There are instances+-- for 'Num' and 'IsString', and turning on @{-\# LANGUAGE OverloadedStrings \#-}@ is+-- strongly recommended.+--+-- The 'fromString' function converts any embedded @$VAR@ into a variable lookup, which may refer to one of+-- the builtin NSIS variables (e.g. @$SMPROGRAMS@, @$TEMP@, @$PROGRAMFILES@), or a named variable+-- created with 'constant' or 'mutable'. The string @$$@ is used to escape @$@ values.+-- Bracket the variables to put text characters afterwards (e.g. @$(SMPROGRAMS)XXX@). In contrast+-- to standard strings, @\/@ is treated as @\\@ and @\/\/@ is treated as @\/@. Remember to escape any+-- slashes occuring in URLs.+--+-- If the string is @'Exp' 'String'@ then any 'Int' variables used will be automatically shown (see 'strShow').+-- If the string is @'Exp' ty@ then it must be of the form @\"$VAR\"@ where @$VAR@ is a variable of type @ty@.+--+-- The 'Eq' and 'Ord' instances for 'Exp' throw errors for all comparisons (use '%==', '%<=' etc),+-- but 'min' and 'max' are defined. The 'Num' (arithmetic) and 'Monoid' (string concatenation) instances are both+-- fully implemented. From 'Integral' and 'Fractional', only '/', 'mod' and 'div' are implemented, and+-- all as integer arithmetic. No functions from 'Enum' or 'Real' are implemented.+--+-- When using a single expression multiple times, to ensure it is not evaluated+-- repeatedly, use 'share'.+type Exp ty = Action (Value ty)++instance forall a . Typeable a => IsString (Exp a) where+ fromString o = do+ scopes <- Action $ gets scopes+ let rty = typeOf (undefined :: a)++ let grab good name = case lookup name $ concat scopes of+ Nothing -> error $ "Couldn't find variable, $" ++ name ++ ", in " ++ show o+ Just (ty,y)+ | ty `notElem` good -> error $ "Type mismatch, $" ++ name ++ " has " ++ show ty +++ ", but you want one of " ++ show good ++ ", in " ++ show o+ | otherwise -> y++ -- "$VAR" permits any type, everything else requires string+ case parseString o of+ [Right var] -> return $ Value $ grab [rty] var+ + _ | rty /= tyString ->+ error $ "Cannot use concatenated variables/literals to produce anything other than String, but you tried " ++ show rty ++ ", in " ++ show o+ xs -> fmap (Value . fromValue) $ strConcat $ flip map xs $ \i -> return $ Value $ case i of+ Left x -> lit x+ Right name -> grab [tyString,tyInt] name+++parseString :: String -> [Either String String]+parseString "" = []+parseString ('/':'/':xs) = Left "/" : parseString xs+parseString ('/':xs) = Left "\\" : parseString xs+parseString ('$':'$':xs) = Left "$" : parseString xs+parseString ('$':'(':xs) = Right a : parseString (drop 1 b)+ where (a,b) = break (== ')') xs+parseString ('$':xs) = Right a : parseString b+ where (a,b) = span isAlphaNum xs+parseString (x:xs) = Left [x] : parseString xs+++instance Show (Exp a) where+ show _ = error "show is not available for Exp"++instance Eq (Exp a) where+ _ == _ = error "(==) is not available for Exp, try (%==) instead"++instance Num (Exp Int) where+ fromInteger = return . Value . lit . show+ (+) = intOp "+"+ (*) = intOp "*"+ (-) = intOp "-"+ abs a = share a $ \a -> a %< 0 ? (negate a, a)+ signum a = share a $ \a -> a %== 0 ? (0, a %< 0 ? (-1, 1)) ++instance Integral (Exp Int) where+ mod = intOp "%"+ toInteger = error "toInteger is not available for Exp"+ div = intOp "/"+ quotRem = error "quotRem is not available for Exp"++instance Enum (Exp Int) where+ toEnum = error "toEnum is not available for Exp"+ fromEnum = error "toEnum is not available for Exp"++instance Real (Exp Int) where+ toRational = error "toRational is not available for Exp"++instance Ord (Exp Int) where+ compare = error "compare is not available for Exp"+ min a b = share a $ \a -> share b $ \b -> a %<= b ? (a, b)+ max a b = share a $ \a -> share b $ \b -> a %<= b ? (b, a)++instance Fractional (Exp Int) where+ fromRational = error "fromRational is not available for Exp, only Int is supported"+ (/) = intOp "/"++instance Monoid (Exp String) where+ mempty = fromString ""+ mappend x y = mconcat [x,y]+ mconcat xs = do+ xs <- sequence xs+ return $ Value $ f $ concatMap fromValue xs+ where+ f (Literal "":xs) = f xs+ f (Literal x:Literal y:zs) = f $ Literal (x++y) : zs+ f (x:xs) = x : f xs+ f [] = []++intOp :: String -> Exp Int -> Exp Int -> Exp Int+intOp cmd x y = do Value x <- x; Value y <- y; v <- var; emit $ IntOp v x cmd y; return $ Value $ val v++emit1 :: (Val -> NSIS) -> Exp a -> Action ()+emit1 f x1 = do Value x1 <- x1; emit $ f x1++emit2 :: (Val -> Val -> NSIS) -> Exp a -> Exp b -> Action ()+emit2 f x1 x2 = do Value x1 <- x1; Value x2 <- x2; emit $ f x1 x2++emit3 :: (Val -> Val -> Val -> NSIS) -> Exp a -> Exp b -> Exp c -> Action ()+emit3 f x1 x2 x3 = do Value x1 <- x1; Value x2 <- x2; Value x3 <- x3; emit $ f x1 x2 x3+++infix 1 @=++-- | Assign a value to a mutable variable. The variable must have been originally created with+-- 'mutable' or 'mutable_', or there will be an error when generating the install file.+(@=) :: Exp t -> Exp t -> Action ()+(@=) v w = do v <- rval v; Value w <- w; emit $ Assign v w+++-- | Introduce a variable scope. Scopes are automatically introduced by operations+-- such as 'iff', 'loop', 'while' etc. Inside a scope you may define new variables+-- whose names may clash with variables outside the scope, but the local versions will be used.+--+-- If you have any non-evaluated expressions, before introducing any potentially clashing+-- variables in the scope you should 'share' them or use 'constant_' on them. For example:+--+-- @+-- operate x = do+-- x <- 'constant_' x+-- 'scope' $ do+-- 'constant' \"TEST\" 0+-- @+--+-- It is important to turn @x@ into a 'constant_' before defining a new constant @$TEST@, since+-- if @x@ refers to @$TEST@ after the new definition, it will pick up the wrong variable.+scope :: Action a -> Action a+scope (Action act) = Action $ do+ s0 <- get+ put s0{scopes=[] : scopes s0}+ res <- act+ modify $ \s -> s{scopes = scopes s0}+ return res+++addScope :: forall t . Typeable t => String -> Value t -> Action ()+addScope name v = Action $+ modify $ \s -> let now:rest = scopes s in+ if name `elem` map fst now+ then error $ "Defined twice in one scope, " ++ name+ else s{scopes=((name,(typeOf (undefined :: t), fromValue v)):now):rest}+ +++-- | Create a mutable variable a name, which can be modified with '@='.+-- After defining the expression, you can refer to it with @$NAME@ in a 'String'.+-- To introduce a new scope, see 'scope'.+--+-- @+-- h <- 'mutable' \"HELLO\" \"Hello World\"+-- \"$HELLO\" '@=' \"$HELLO!\"+-- h '@=' \"$HELLO!\" -- equivalent to the above+-- 'alert' \"$HELLO\" -- with 2 exclamation marks+-- @+mutable :: Typeable t => String -> Exp t -> Action (Exp t)+mutable name x = do+ v <- mutable_ x+ vv <- v+ addScope name vv+ return v++-- | Create an unnamed mutable variable, which can be modified with '@='.+--+-- @+-- h <- 'mutable' \"Hello World\"+-- h '@=' 'h' '&' \"!\"+-- 'alert' h+-- @+mutable_ :: Exp t -> Action (Exp t)+mutable_ x = do+ v <- var+ let v2 = return $ Value $ val v+ v2 @= x+ return v2+++-- | Create a constant with a name, ensuring the expression is shared.+-- After defining the expression, you can refer to it with @$NAME@ in a 'String'.+-- To introduce a new scope, see 'scope'.+--+-- @+-- 'constant' "HELLO" "Hello World"+-- 'alert' "$HELLO!"+-- @+constant :: Typeable t => String -> Exp t -> Action (Exp t)+constant name x = do x <- constant_ x; xx <- x; addScope name xx; return x++-- | 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++-- | 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+-- 'Exp', if you use the same input expression twice, you should share it. For example:+--+-- @+-- strPalindrom x = 'share' x $ \\x -> x '%==' strReverse x+-- @+--+-- If the expression was not shared, and @x@ read from a file, then the file would be read twice.+share :: Exp t -> (Exp t -> Action a) -> Action a+share v act = do v <- constant_ v; act v+++-- | Versions of 'mutable' and 'constant' restricted to 'Exp' 'Int', used to avoid+-- ambiguous type errors.+mutableInt, constantInt :: String -> Exp Int -> Action (Exp Int)+mutableInt = mutable+constantInt = constant++-- | Versions of 'mutable_' and 'constant_' restricted to 'Exp' 'Int', used to avoid+-- ambiguous type errors.+mutableInt_, constantInt_ :: Exp Int -> Action (Exp Int)+mutableInt_ = mutable_+constantInt_ = constant_++-- | Versions of 'mutable' and 'constant' restricted to 'Exp' 'String', used to avoid+-- ambiguous type errors.+mutableStr, constantStr :: String -> Exp String -> Action (Exp String)+mutableStr = mutable+constantStr = constant++-- | Versions of 'mutable_' and 'constant_' restricted to 'Exp' 'String', used to avoid+-- ambiguous type errors.+mutableStr_, constantStr_ :: Exp String -> Action (Exp String)+mutableStr_ = mutable_+constantStr_ = constant_+++---------------------------------------------------------------------+-- EXPRESSION WRAPPERS++-- | Perform string concatenation on a list of expressions.+strConcat :: [Exp String] -> Exp String+strConcat = mconcat++-- | Boolean negation.+not_ :: Exp Bool -> Exp Bool+not_ a = a ? (false, true)++infix 4 %==, %/=, %<=, %<, %>=, %>++-- | The standard equality operators, lifted to 'Exp'.+(%==), (%/=) :: Exp a -> Exp a -> Exp Bool+(%==) a b = do+ Value a <- a+ Value b <- b+ v <- mutable_ false+ eq <- newLabel+ end <- newLabel+ emit $ StrCmpS a b eq end+ label eq+ v @= true+ label end+ v++(%/=) a b = not_ (a %== b)++-- | The standard comparison operators, lifted to 'Exp'.+(%<=), (%<), (%>=), (%>) :: Exp Int -> Exp Int -> Exp Bool+(%<=) = comp True True False+(%<) = comp False True False+(%>=) = comp True False True+(%>) = comp False False True+++comp :: Bool -> Bool -> Bool -> Exp Int -> Exp Int -> Exp Bool+comp eq lt gt a b = do+ Value a <- a+ Value b <- b+ v <- mutable_ false+ yes <- newLabel+ end <- newLabel+ let f b = if b then yes else end+ emit $ IntCmp a b (f eq) (f lt) (f gt)+ label yes+ v @= true+ label end+ v+++-- | Boolean constants corresponding to 'True' and 'False'+true, false :: Exp Bool+false = return $ Value []+true = return $ Value [Literal "1"]+++-- | Return the length of a string, @strLength \"test\" '%==' 4@.+strLength :: Exp String -> Exp Int+strLength a = do Value a <- a; v <- var; emit $ StrLen v a; return $ Value $ val v++-- | Take the first @n@ characters from a string, @strTake 2 \"test\" '%==' \"te\"@.+strTake :: Exp Int -> Exp String -> Exp String+strTake n x = do Value n <- n; Value x <- x; v <- var; emit $ StrCpy v x n (lit ""); return $ Value $ val v++-- | Drop the first @n@ characters from a string, @strDrop 2 \"test\" '%==' \"st\"@.+strDrop :: Exp Int -> Exp String -> Exp String+strDrop n x = do Value n <- n; Value x <- x; v <- var; emit $ StrCpy v x (lit "") n; return $ Value $ val v++getFileTime :: Exp FilePath -> Exp String+getFileTime x = do Value x <- x; v1 <- var; v2 <- var; emit $ GetFileTime x v1 v2; strConcat [return $ Value $ val v1, "#", return $ Value $ val v2]++sectionGetText :: SectionId -> Exp String+sectionGetText x = do v <- var; emit $ SectionGetText x v; return $ Value $ val v++readRegStr :: HKEY -> Exp String -> Exp String -> Exp String+readRegStr k a b = do v <- var; emit2 (ReadRegStr v k) a b; return $ Value $ val v++deleteRegKey :: HKEY -> Exp String -> Action ()+deleteRegKey k = emit1 (DeleteRegKey k)+++---------------------------------------------------------------------+-- ATTRIBUTES++data Attrib+ = Solid+ | Final+ | RebootOK+ | NonFatal+ | Recursive+ | Unselected+ | Expanded+ | Description (Exp String)+ | Required+ | Target (Exp String)+ | Parameters (Exp String)+ | IconFile (Exp String)+ | IconIndex (Exp Int)+ | StartOptions String+ | KeyboardShortcut String+ | Id SectionId+ deriving Show+++---------------------------------------------------------------------+-- STATEMENT WRAPPERS++-- | Define the location of a 'label', see 'newLabel' for details. This function will fail+-- if the same 'Label' is passed to 'label' more than once.+label :: Label -> Action ()+label lbl = emit $ Labeled lbl++-- | Jump to a 'label', see 'newLabel' for details. This function will fail+-- if 'label' is not used on the 'Label'.+goto :: Label -> Action ()+goto lbl = emit $ Goto lbl+++infix 2 ?++-- | An expression orientated version of 'iff', returns the first component if+-- the first argument is 'true' or the second if it is 'false'.+--+-- @+-- x '%==' 12 '?' (x, x '+' 5)+-- @+(?) :: Exp Bool -> (Exp t, Exp t) -> Exp t+(?) test (true, false) = do+ v <- var+ let v2 = return $ Value $ val v+ iff test (v2 @= true) (v2 @= false)+ v2++-- | Test a boolean expression, reunning the first action if it is 'true' and the second if it is 'false'.+-- The appropriate branch action will be run within a 'scope'. See '?' for an expression orientated version.+--+-- @+-- 'iff' (x '%==' 12) ('alert' \"is 12\") ('alert' \"is not 12\")+-- @+iff :: Exp Bool -> Action () -> Action () -> Action ()+iff test true false = do+ thn <- newLabel+ els <- newLabel+ end <- newLabel+ Value t <- test+ emit $ StrCmpS t (lit "") thn els+ label thn+ scope false+ goto end+ label els+ scope true+ label end+++-- | A version of 'iff' where there is no else action.+iff_ :: Exp Bool -> Action () -> Action ()+iff_ test true = iff test true (return ())+++-- | A while loop, run the second argument while the first argument is true.+-- The action is run in a 'scope'. See also 'loop'.+--+-- @+-- x <- 'mutable_' x+-- 'while' (x '%<' 10) $ do+-- x '@=' x '+' 1+-- @+while :: Exp Bool -> Action () -> Action ()+while test act = do+ start <- newLabel+ label start+ iff_ test (scope act >> goto start)++-- | A loop with a @break@ command. Run the action repeatedly until the breaking action+-- is called. The action is run in a 'scope'. See also 'while'.+--+-- @+-- x <- 'mutable_' x+-- 'loop' $ \\break -> do+-- 'iff_' (x '%>=' 10) break+-- x '@=' x '+' 1+-- @+loop :: (Action () -> Action ()) -> Action ()+loop body = do+ end <- newLabel+ beg <- newLabel+ label beg+ scope $ body $ goto end+ goto beg+ label end++-- | Run an intitial action, and if that action causes an error, run the second action.+-- Unlike other programming languages, any uncaught errors are silently ignored.+-- All actions are run in 'scope'.+--+-- @+-- 'onError' ('exec' \"\\\"$WINDIR/notepad.exe\\\"\") ('alert' \"Failed to run notepad\")+-- @+onError :: Action () -> Action () -> Action ()+onError act catch = do+ emit ClearErrors+ scope act+ end <- newLabel+ err <- newLabel+ emit $ IfErrors err end+ label err+ scope catch+ label end+++fileExists :: Exp FilePath -> Exp Bool+fileExists x = do+ v <- mutable_ false+ Value x <- x+ yes <- newLabel+ end <- newLabel+ emit $ IfFileExists x yes end+ label yes+ v @= true+ label end+ v+++-- If you jump from inside the loop to outside then you may leak a find handle+findEach :: Exp FilePath -> (Exp FilePath -> Action ()) -> Action ()+findEach spec act = do+ Value spec <- spec+ hdl <- var+ v <- var+ emit $ FindFirst hdl v spec+ while (return (Value $ val v)) $ do+ scope $ act $ return $ Value $ val v+ emit $ FindNext (val hdl) v+ emit $ FindClose $ val hdl+++-- return either "" for no patterns matched, or the first file+findOnce :: Exp FilePath -> Exp String+findOnce spec = do+ -- can't use findEach + jump since then we leak a find handle+ Value spec <- spec+ hdl <- var+ v <- var+ emit $ FindFirst hdl v spec+ emit $ FindClose $ val hdl+ return $ Value $ val v+++infixr 5 &++-- | Concatenate two strings, for example @\"$FOO\" & \"$BAR\"@ is equivalent+-- to @\"$FOO$BAR\"@.+(&) :: Exp String -> Exp String -> Exp String+(&) a b = strConcat [a,b]+++-- |Convert an 'Int' to a 'String'.+strShow :: Exp Int -> Exp String+strShow = fmap (Value . fromValue)+++-- | Convert a 'String' to an 'Int', any errors are silently ignored.+strRead :: Exp String -> Exp Int+strRead = fmap (Value . fromValue)+++alert :: Exp String -> Action ()+alert x = do+ _ <- messageBox [MB_ICONEXCLAMATION] x+ return ()+++++---------------------------------------------------------------------+-- SETTINGS WRAPPERS++-- | Sets the name of the installer. The name is usually simply the product name such as \'MyApp\' or \'Company MyApp\'.+--+-- > name "MyApp"+name :: Exp String -> Action ()+name = emit1 Name++-- | Specifies the output file that @MakeNSIS@ should write the installer to.+-- This is just the file that MakeNSIS writes, it doesn't affect the contents of the installer.+-- Usually should end with @.exe@.+--+-- > outFile "installer.exe"+outFile :: Exp FilePath -> Action ()+outFile = emit1 OutFile++-- | Sets the output path (@$OUTDIR@) and creates it (recursively if necessary), if it does not exist.+-- Must be a full pathname, usually is just @$INSTDIR@.+--+-- > setOutPath "$INSTDIR"+setOutPath :: Exp FilePath -> Action ()+setOutPath = emit1 SetOutPath++-- | Sets the default installation directory.+-- Note that the part of this string following the last @\\@ will be used if the user selects 'browse', and+-- may be appended back on to the string at install time (to disable this, end the directory with a @\\@).+-- If this doesn't make any sense, play around with the browse button a bit.+--+-- > installDir "$PROGRAMFILES/MyApp"+installDir :: Exp FilePath -> Action ()+installDir = emit1 InstallDir++-- | Writes the uninstaller to the filename (and optionally path) specified.+-- Only valid from within an install section, and requires that you have an 'uninstall' section in your script.+-- You can call this one or more times to write out one or more copies of the uninstaller.+--+-- > writeUninstaller "$INSTDIR/uninstaller.exe"+writeUninstaller :: Exp FilePath -> Action ()+writeUninstaller = emit1 WriteUninstaller++-- | Set the icon used for the installer\/uninstaller.+--+-- > installIcon "NSISDIR/Contrib/Graphics/Icons/modern-install.ico"+installIcon, uninstallIcon :: Exp FilePath -> Action ()+installIcon = emit1 InstallIcon+uninstallIcon = emit1 UninstallIcon++-- | Set the image used for the header splash. Pass 'Nothing' to use the default header image.+--+-- > headerImage $ Just "$NSISDIR/Contrib/Graphics/Header/win.bmp"+headerImage :: Maybe (Exp FilePath) -> Action ()+headerImage Nothing = emit $ HeaderImage Nothing+headerImage (Just x) = emit1 (HeaderImage . Just) x++-- | Creates (recursively if necessary) the specified directory. Errors can be caught+-- using 'onError'. You should always specify an absolute path.+--+-- > createDirectory "$INSTDIR/some/directory"+createDirectory :: Exp FilePath -> Action ()+createDirectory = emit1 CreateDirectory++-- | This attribute tells the installer to check a string in the registry,+-- and use it for the install dir if that string is valid. If this attribute is present,+-- it will override the 'installDir' attribute if the registry key is valid, otherwise+-- it will fall back to the 'installDir' default. When querying the registry, this command+-- will automatically remove any quotes. If the string ends in \".exe\", it will automatically+-- remove the filename component of the string (i.e. if the string is \"C:/program files/foo/foo.exe\",+-- it will know to use \"C:/program files/foo\").+--+-- > installDirRegKey HKLM "Software/NSIS" ""+-- > installDirRegKey HKLM "Software/ACME/Thingy" "InstallLocation"+installDirRegKey :: HKEY -> Exp String -> Exp String -> Action ()+installDirRegKey k = emit2 $ InstallDirRegKey k++-- | Execute the specified program and continue immediately. Note that the file specified+-- must exist on the target system, not the compiling system. @$OUTDIR@ is used for the working+-- directory. Errors can be caught using 'onError'. Note, if the command could have spaces,+-- you should put it in quotes to delimit it from parameters. e.g.: @exec \"\\\"$INSTDIR/command.exe\\\" parameters\"@.+-- If you don't put it in quotes it will not work on Windows 9x with or without parameters.+--+-- > exec "\"$INSTDIR/someprogram.exe\""+-- > exec "\"$INSTDIR/someprogram.exe\" some parameters"+exec :: Exp String -> Action ()+exec = emit1 Exec++sectionSetText :: SectionId -> Exp String -> Action ()+sectionSetText x = emit1 $ SectionSetText x++-- don't want to accidentally dupe the message box, so make it in Action Exp+messageBox :: [MessageBoxType] -> Exp String -> Action (Exp String)+messageBox ty x = do+ let a*b = (a, words b)+ let alts = [MB_OK * "OK"+ ,MB_OKCANCEL * "OK CANCEL"+ ,MB_ABORTRETRYIGNORE * "ABORT RETRY IGNORE"+ ,MB_RETRYCANCEL * "RETRY CANCEL"+ ,MB_YESNO * "YES NO"+ ,MB_YESNOCANCEL * "YES NO CANCEL"]+ let (btns,rest) = partition (`elem` map fst alts) ty+ let btn = last $ MB_OK : btns+ let alt = fromJust $ lookup btn alts++ end <- newLabel+ lbls <- replicateM (length alt) newLabel+ v <- mutable_ ""+ Value x <- x+ emit $ MessageBox (btn:rest) x $ zip alt lbls+ forM_ (zip alt lbls) $ \(a,l) -> do+ label l+ v @= fromString a+ goto end+ label end+ return v++writeRegStr :: HKEY -> Exp String -> Exp String -> Exp String -> Action ()+writeRegStr k = emit3 $ WriteRegStr k++writeRegDWORD :: HKEY -> Exp String -> Exp String -> Exp Int -> Action ()+writeRegDWORD k = emit3 $ WriteRegDWORD k++hideProgress :: Action a -> Action a+hideProgress act = do+ fun <- fmap Fun unique+ (xs, v) <- capture act+ emit $ Function fun xs+ emit $ Call fun+ return v++allowRootDirInstall :: Bool -> Action ()+allowRootDirInstall = emit . AllowRootDirInstall++caption :: Exp String -> Action ()+caption = emit1 Caption++detailPrint :: Exp String -> Action ()+detailPrint = emit1 DetailPrint++showInstDetails :: Visibility -> Action ()+showInstDetails = emit . ShowInstDetails++showUninstDetails :: Visibility -> Action ()+showUninstDetails = emit . ShowUninstDetails+++-- | The type of a file handle, created by 'fileOpen'.+data FileHandle deriving Typeable++-- | Open a file, which must be closed explicitly with 'fileClose'.+-- Often it is better to use 'Development.NSIS.Sugar.writeFile'' or+-- 'Development.NSIS.Sugar.withFile' instead.+--+-- @+-- h <- 'fileOpen' 'ModeWrite' \"C:/log.txt\"+-- 'fileWrite' h \"Hello world!\"+-- 'fileClose' h+-- @+fileOpen :: FileMode -> Exp FilePath -> Action (Exp FileHandle)+fileOpen mode name = do+ Value name <- name+ v <- var+ emit $ FileOpen v name mode+ return $ return $ Value $ val v++-- | Write a string to a file openned with 'fileOpen'.+fileWrite :: Exp FileHandle -> Exp String -> Action ()+fileWrite = emit2 FileWrite++-- | Close a file file openned with 'fileOpen'.+fileClose :: Exp FileHandle -> Action ()+fileClose = emit1 FileClose++setCompressor :: Compressor -> [Attrib] -> Action ()+setCompressor x as = emit $ SetCompressor $ foldl f def{compType=x} as+ where+ f c Final = c{compFinal=True}+ f c Solid = c{compSolid=True}+ f c x = error $ "Invalid attribute to setCompress: " ++ show x++file :: [Attrib] -> Exp FilePath -> Action ()+file as x = do Value x <- x; emit $ File $ foldl f def{filePath=x} as+ where+ f c Recursive = c{fileRecursive=True}+ f c NonFatal = c{fileNonFatal=True}+ f c x = error $ "Invalid attribute to file: " ++ show x++section :: Exp String -> [Attrib] -> Action () -> Action ()+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+ where+ f c Unselected = return c{secUnselected=True}+ f c Required = return c{secRequired=True}+ f c (Description x) = do Value x <- x; return c{secDescription=x}+ 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 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+ where+ f c Expanded = return c{secgExpanded=True}+ f c (Description x) = do Value x <- x; return c{secgDescription=x}+ f c (Id x) = return c{secgId=x}+ f c x = error $ "Invalid attribute to sectionGroup: " ++ show x++uninstall :: Action () -> Action ()+uninstall = section "Uninstall" []++delete :: [Attrib] -> Exp FilePath -> Action ()+delete as x = do+ Value x <- x+ emit $ Delete $ foldl f def{delFile=x} as+ where+ f c RebootOK = c{delRebootOK=True}+ f c x = error $ "Invalid attribute to delete: " ++ show x++rmdir :: [Attrib] -> Exp FilePath -> Action ()+rmdir as x = do+ Value x <- x+ emit $ RMDir $ foldl f def{rmDir=x} as+ where+ f c RebootOK = c{rmRebootOK=True}+ f c Recursive = c{rmRecursive=True}+ f c x = error $ "Invalid attribute to rmdir: " ++ show x++createShortcut :: Exp FilePath -> [Attrib] -> Action ()+createShortcut name as = do Value name <- name; x <- foldM f def{scFile=name} as; emit $ CreateShortcut x+ where+ f c (Target x) = do Value x <- x; return c{scTarget=x}+ f c (Parameters x) = do Value x <- x; return c{scParameters=x}+ f c (IconFile x) = do Value x <- x; return c{scIconFile=x}+ f c (IconIndex x) = do Value x <- x; return c{scIconIndex=x}+ f c (StartOptions x) = return c{scStartOptions=x}+ f c (KeyboardShortcut x) = return c{scKeyboardShortcut=x}+ f c (Description x) = do Value x <- x; return c{scDescription=x}+ f c x = error $ "Invalid attribute to shortcut: " ++ show x+++page :: Page -> Action ()+page = emit . Page++unpage :: Page -> Action ()+unpage = emit . Unpage++requestExecutionLevel :: Level -> Action ()+requestExecutionLevel = emit . RequestExecutionLevel
+ Development/NSIS/Type.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Development.NSIS.Type where++import Data.Data++class Default a where def :: a+instance Default (Maybe a) where def = Nothing+instance Default [a] where def = []+++newtype Var = Var Int deriving (Data,Typeable,Eq)+instance Default Var where def = Var 0+instance Show Var where show (Var i) = "$_" ++ show i+++-- | A code label, used for @goto@ programming, see 'Development.NSIS.Sugar.newLabel'.+newtype Label = Label Int deriving (Data,Typeable,Eq)+instance Show Label where show (Label i) = if i == 0 then "0" else "_lbl" ++ show i+++newtype Fun = Fun Int deriving (Data,Typeable)+instance Show Fun where show (Fun i) = "_fun" ++ show i+++newtype SectionId = SectionId Int deriving (Data,Typeable)+instance Show SectionId where show (SectionId i) = "${_sec" ++ show i ++ "}"+++type Val = [Val_]+data Val_ = Var_ Var | Builtin String | Literal String deriving (Data,Typeable,Eq)++instance Show Val_ where+ show x = show [x]+ showList xs = showString $ "\"" ++ concatMap f xs ++ "\""+ where+ f (Var_ x) = show x+ f (Builtin x) = "$" ++ x+ f (Literal x) = concatMap g x++ g '\"' = "$\\\""+ g '\r' = "$\\r"+ g '\n' = "$\\n"+ g '\t' = "$\\t"+ g '$' = "$$"+ g x = [x]+++data NSIS+ -- primitives+ = Assign Var Val+ | Goto Label+ | Labeled Label++ -- functions and branches+ | StrCmpS Val Val Label Label+ | IntCmp Val Val Label Label Label+ | IntOp Var Val String Val+ | StrCpy Var Val Val Val+ | StrLen Var Val+ | GetFileTime Val Var Var+ | IfErrors Label Label+ | SectionGetText SectionId Var+ | SectionSetText SectionId Val+ | IfFileExists Val Label Label+ | FindFirst Var Var Val+ | FindNext Val Var+ | FindClose Val++ -- blocks+ | Section ASection [NSIS]+ | SectionGroup ASectionGroup [NSIS]+ | Function Fun [NSIS]+ | Call Fun++ -- Global settings+ | Name Val+ | File AFile+ | OutFile Val+ | InstallDir Val+ | InstallIcon Val+ | UninstallIcon Val+ | HeaderImage (Maybe Val)+ | Page Page+ | Unpage Page++ -- Actions+ | SetOutPath Val+ | CreateDirectory Val+ | SetCompressor ACompressor+ | WriteUninstaller Val+ | FileOpen Var Val FileMode+ | FileWrite Val Val+ | FileClose Val+ | MessageBox [MessageBoxType] Val [(String,Label)]+ | CreateShortcut AShortcut+ | WriteRegStr HKEY Val Val Val+ | WriteRegDWORD HKEY Val Val Val+ | ReadRegStr Var HKEY Val Val+ | DeleteRegKey HKEY Val+ | Exec Val+ | ClearErrors+ | Delete ADelete+ | RMDir ARMDir+ | RequestExecutionLevel Level+ | InstallDirRegKey HKEY Val Val+ | AllowRootDirInstall Bool+ | Caption Val+ | ShowInstDetails Visibility+ | ShowUninstDetails Visibility+ | DetailPrint Val+ deriving (Data,Typeable,Show)++-- | Mode to use with 'Development.+data FileMode+ = ModeRead -- ^ Read a file.+ | ModeWrite -- All contents of file are destroyed.+ | ModeAppend -- ^ Opened for both read and write, contents preserved.+ deriving (Data,Typeable,Bounded,Enum,Eq,Ord)+ +instance Show FileMode where+ show ModeRead = "r"+ show ModeWrite = "w"+ show ModeAppend = "a"+++data AShortcut = AShortcut+ {scFile :: Val+ ,scTarget :: Val+ ,scParameters :: Val+ ,scIconFile :: Val+ ,scIconIndex :: Val+ ,scStartOptions :: String+ ,scKeyboardShortcut :: String+ ,scDescription :: Val+ } deriving (Data,Typeable,Show)++instance Default AShortcut where def = AShortcut def def def def def def def def++data ASection = ASection+ {secId :: SectionId+ ,secName :: Val+ ,secDescription :: Val+ ,secBold :: Bool+ ,secRequired :: Bool+ ,secUnselected :: Bool+ } deriving (Data,Typeable,Show)++instance Default ASection where def = ASection (SectionId 0) def def False False False++data ASectionGroup = ASectionGroup+ {secgId :: SectionId+ ,secgName :: Val+ ,secgExpanded :: Bool+ ,secgDescription :: Val+ } deriving (Data,Typeable,Show)++instance Default ASectionGroup where def = ASectionGroup (SectionId 0) def False def++data Compressor = LZMA | ZLIB | BZIP2 deriving (Data,Typeable,Show)++instance Default Compressor where def = ZLIB++data ACompressor = ACompressor + {compType :: Compressor+ ,compSolid :: Bool+ ,compFinal :: Bool+ } deriving (Data,Typeable,Show)++instance Default ACompressor where def = ACompressor def False False++data AFile = AFile+ {filePath :: Val+ ,fileNonFatal :: Bool+ ,fileRecursive :: Bool+ } deriving (Data,Typeable,Show)++instance Default AFile where def = AFile def False False++data ARMDir = ARMDir+ {rmDir :: Val+ ,rmRecursive :: Bool+ ,rmRebootOK :: Bool+ } deriving (Data,Typeable,Show)++instance Default ARMDir where def = ARMDir def False False++data ADelete = ADelete+ {delFile :: Val+ ,delRebootOK :: Bool+ } deriving (Data,Typeable,Show)++instance Default ADelete where def = ADelete def False++data HKEY+ = HKCR | HKEY_CLASSES_ROOT+ | HKLM | HKEY_LOCAL_MACHINE+ | HKCU | HKEY_CURRENT_USER+ | HKU | HKEY_USERS+ | HKCC | HKEY_CURRENT_CONFIG+ | HKDD | HKEY_DYN_DATA+ | HKPD | HKEY_PERFORMANCE_DATA+ | SHCTX | SHELL_CONTEXT+ deriving (Show,Data,Typeable,Read,Bounded,Enum,Eq,Ord)++data MessageBoxType+ = MB_OK -- ^ Display with an OK button+ | MB_OKCANCEL -- ^ Display with an OK and a cancel button+ | MB_ABORTRETRYIGNORE -- ^ Display with abort, retry, ignore buttons+ | MB_RETRYCANCEL -- ^ Display with retry and cancel buttons+ | MB_YESNO -- ^ Display with yes and no buttons+ | MB_YESNOCANCEL -- ^ Display with yes, no, cancel buttons+ | MB_ICONEXCLAMATION -- ^ Display with exclamation icon+ | MB_ICONINFORMATION -- ^ Display with information icon+ | MB_ICONQUESTION -- ^ Display with question mark icon+ | MB_ICONSTOP -- ^ Display with stop icon+ | MB_USERICON -- ^ Display with installer's icon+ | MB_TOPMOST -- ^ Make messagebox topmost+ | MB_SETFOREGROUND -- ^ Set foreground+ | MB_RIGHT -- ^ Right align text+ | MB_RTLREADING -- ^ RTL reading order+ | MB_DEFBUTTON1 -- ^ Button 1 is default+ | MB_DEFBUTTON2 -- ^ Button 2 is default+ | MB_DEFBUTTON3 -- ^ Button 3 is default+ | MB_DEFBUTTON4 -- ^ Button 4 is default+ deriving (Show,Data,Typeable,Read,Bounded,Enum,Eq,Ord)+instance Default MessageBoxType where def = MB_ICONINFORMATION+++data Page+ = License+ | Components+ | Directory+ | InstFiles+ | Confirm+ deriving (Show,Data,Typeable,Read,Bounded,Enum,Eq,Ord)++data Level = None | User | Highest | Admin+ deriving (Show,Data,Typeable,Read,Bounded,Enum,Eq,Ord)++data Visibility = Hide | Show | NeverShow+ deriving (Show,Data,Typeable,Read,Bounded,Enum,Eq,Ord)
+ Examples/Example1.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Examples.Example1(example1) where++import Development.NSIS+++-- Based on example1.nsi from NSIS+--+-- This script is perhaps one of the simplest NSIs you can make. All of the+-- optional settings are left to their default settings. The installer simply +-- prompts the user asking them where to install, and drops a copy of example1.hs+-- there. +example1 = do+ + -- The name of the installer+ name "Example1"++ -- The file to write+ outFile "example1.exe"++ -- The default installation directory+ installDir "$DESKTOP/Example1"++ -- Request application privileges for Windows Vista+ requestExecutionLevel User++ ---------------------------------++ -- Pages+ + page Directory+ page InstFiles++ ---------------------------------++ -- The stuff to install+ section "" [] $ do -- No components page, name is not important++ -- Set output path to the installation directory.+ setOutPath "$INSTDIR"++ -- Put file there+ file [] "Examples/Example1.hs"
+ Examples/Example2.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}++module Examples.Example2(example2) where++import Development.NSIS++-- Based on example2.nsi from NSIS+--+-- This script is based on example1.nsi, but it remember the directory, +-- has uninstall support and (optionally) installs start menu shortcuts.+--+-- It will install example2.nsi into a directory that the user selects,++----------------------------------++example2 = do+ -- The name of the installer+ name "Example2"++ -- The file to write+ outFile "example2.exe"++ -- The default installation directory+ installDir "$PROGRAMFILES/Example2"++ -- Registry key to check for directory (so if you install again, it will + -- overwrite the old one automatically)+ installDirRegKey HKLM "Software/NSIS_Example2" "Install_Dir"++ -- Request application privileges for Windows Vista+ requestExecutionLevel Admin++ ----------------------------------++ -- Pages++ page Components+ page Directory+ page InstFiles++ unpage Confirm+ unpage InstFiles++ ----------------------------------++ -- The stuff to install+ section "Example2 (required)" [Required] $ do++ -- Set output path to the installation directory.+ setOutPath "$INSTDIR"++ -- Put file there+ file [] "Examples/Example2.hs"++ -- Write the installation path into the registry+ writeRegStr HKLM "SOFTWARE/NSIS_Example2" "Install_Dir" "$INSTDIR"++ -- Write the uninstall keys for Windows+ writeRegStr HKLM "Software/Microsoft/Windows/CurrentVersion/Uninstall/Example2" "DisplayName" "NSIS Example2"+ writeRegStr HKLM "Software/Microsoft/Windows/CurrentVersion/Uninstall/Example2" "UninstallString" "\"$INSTDIR/uninstall.exe\""+ writeRegDWORD HKLM "Software/Microsoft/Windows/CurrentVersion/Uninstall/Example2" "NoModify" 1+ writeRegDWORD HKLM "Software/Microsoft/Windows/CurrentVersion/Uninstall/Example2" "NoRepair" 1+ writeUninstaller "uninstall.exe"++ -- Optional section (can be disabled by the user)+ section "Start Menu Shortcuts" [] $ do++ createDirectory "$SMPROGRAMS/Example2"+ createShortcut "$SMPROGRAMS/Example2/Uninstall.lnk" [Target "$INSTDIR/uninstall.exe", IconFile "$INSTDIR/uninstall.exe", IconIndex 0]+ createShortcut "$SMPROGRAMS/Example2/Example2 (MakeNSISW).lnk" [Target "$INSTDIR/example2.nsi", IconFile "$INSTDIR/example2.nsi", IconIndex 0]++ ----------------------------------++ -- Uninstaller++ uninstall $ do++ -- Remove registry keys+ deleteRegKey HKLM "Software/Microsoft/Windows/CurrentVersion/Uninstall/Example2"+ deleteRegKey HKLM "SOFTWARE/NSIS_Example2"++ -- Remove files and uninstaller+ delete [] "$INSTDIR/example2.nsi"+ delete [] "$INSTDIR/uninstall.exe"++ -- Remove shortcuts, if any+ delete [] "$SMPROGRAMS/Example2/*.*"++ -- Remove directories used+ rmdir [] "$SMPROGRAMS/Example2"+ rmdir [] "$INSTDIR"
+ Examples/Primes.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++module Examples.Primes(primes) where++import Development.NSIS++-- Based on primes.nsi from NSIS+--+-- This is an example of the possibities of the NSIS Script language.+-- It calculates prime numbers.++----------------------------------++primes = do++ name "primes"+ allowRootDirInstall True+ outFile "primes.exe"+ caption "Prime number generator"+ showInstDetails Show+ installDir "$EXEDIR"+ requestExecutionLevel User++ ----------------------------------++ --Pages++ page Directory+ page InstFiles++ ----------------------------------++ section "" [] $ do+ setOutPath "$INSTDIR"+ hideProgress doPrimes+++doPrimes = do+ hdl <- fileOpen ModeWrite "$INSTDIR/primes.txt"++ let output x = do+ detailPrint $ strShow x & " is prime!"+ fileWrite hdl $ strShow x & " is prime!\r\n"+ output 2+ output 3++ ppos <- mutableInt "PPOS" 5 -- position in prime searching+ pdiv <- mutableInt "PDIV" 0 -- divisor+ pcnt <- mutableInt "PCNT" 2 -- count of how many we've printed+ loop $ \breakOuter -> do+ pdiv @= 3+ loop $ \breakInner -> do+ iff_ (ppos `mod` pdiv %== 0) $ do+ ppos @= ppos + 2+ breakInner+ pdiv @= pdiv + 2+ iff_ (pdiv %>= ppos) $ do+ output ppos+ pcnt @= pcnt + 1+ iff_ (pcnt %== 100) $ do+ pcnt @= 0+ ans <- messageBox [MB_YESNO] "Process more?"+ iff_ (ans %== "NO")+ breakOuter++ fileClose hdl
+ LICENSE view
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ Main.hs view
@@ -0,0 +1,35 @@++module Main where++import Control.Monad+import Data.List+import Data.Maybe+import System.Cmd+import System.Environment+import System.Exit++import Development.NSIS+import Examples.Example1+import Examples.Example2+import Examples.Primes+++examples = let (*) = (,) in ["example1" * example1, "example2" * example2, "primes" * primes]+++main = do+ args <- getArgs+ let (flags,names) = partition ("-" `isPrefixOf`) args+ names <- return $ concatMap (\x -> if x == "all" then map fst examples else [x]) names+ if null names then+ putStrLn $ "Type the name of an example: " ++ unwords (map fst examples)+ else do+ forM_ names $ \name -> do+ let script = fromMaybe (error $ "Unknown example: " ++ name) $ lookup name examples+ unless ("--nowrite" `elem` flags) $ writeFile (name ++ ".nsi") $ nsis script+ unless ("--nobuild" `elem` flags) $ do+ r <- system $ "\"C:/Program Files/NSIS/makensis.exe\" " ++ name ++ ".nsi"+ when (r /= ExitSuccess) $ error "NSIS FAILED"+ when ("--run" `elem` flags) $ do+ system $ name ++ ".exe"+ return ()
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ nsis.cabal view
@@ -0,0 +1,54 @@+cabal-version: >= 1.6+build-type: Simple+name: nsis+version: 0.1+-- license is GPL v2 only+license: GPL+license-file: LICENSE+category: Development+author: Neil Mitchell <ndmitchell@gmail.com>+maintainer: Neil Mitchell <ndmitchell@gmail.com>+copyright: Neil Mitchell 2012+synopsis: Build NSIS Installers+description:+ Helps writing NSIS Installers, see <http://nsis.sourceforge.net/>.+homepage: http://community.haskell.org/~ndm/nsis/+stability: Beta++source-repository head+ type: darcs+ location: http://community.haskell.org/~ndm/darcs/nsis/++library+ build-depends:+ base == 4.*,+ transformers == 0.2.*,+ uniplate >= 1.5 && < 1.7++ exposed-modules:+ Development.NSIS+ other-modules:+ Development.NSIS.Library+ Development.NSIS.Optimise+ Development.NSIS.Show+ Development.NSIS.Sugar+ Development.NSIS.Type++flag testprog+ default: False+ description: Build the test program+++executable nsis+ main-is: Main.hs+ if flag(testprog)+ buildable: True+ else+ buildable: False+ build-depends:+ process++ other-modules:+ Examples.Example1+ Examples.Example2+ Examples.Primes