Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

initial code

  • Loading branch information...
commit d2f1735318fd1039ee0531d1669c3aebfd9cb3b3 1 parent bdaac3b
atzedijkstra authored October 05, 2012
32  macosx-make-standalone.cabal
... ...
@@ -0,0 +1,32 @@
  1
+Name:                macosx-make-standalone
  2
+Version:             0.1
  3
+Synopsis:            Make a macosx app standalone deployable
  4
+Description:         Make a macosx app standalone by bundling all dylibs into it.
  5
+License:             BSD3
  6
+Author:              Atze Dijkstra
  7
+Maintainer:          atze@uu.nl
  8
+Homepage:            https://github.com/atzedijkstra
  9
+Bug-Reports:         https://github.com/atzedijkstra/issues
  10
+Copyright:           2012 Utrecht University
  11
+Category:            Development
  12
+Build-type:          Simple
  13
+Cabal-version:       >=1.6
  14
+
  15
+Executable macosx-make-standalone
  16
+  HS-Source-Dirs: src
  17
+  Main-is: MakeStandalone.hs
  18
+  GHC-Options: 
  19
+  Extensions: ScopedTypeVariables, TemplateHaskell, DeriveDataTypeable
  20
+  Build-depends:
  21
+    base >= 4 && < 5,
  22
+    data-lens >= 2 && < 3,
  23
+    data-lens-template >= 2 && < 3,
  24
+    mtl >= 2 && < 3,
  25
+    containers >= 0.4 && < 0.5,
  26
+    transformers,
  27
+    directory,
  28
+    filepath,
  29
+    process,
  30
+    unix,
  31
+    deepseq,
  32
+    graph-visit >= 0.1.0.1 && < 0.2
112  src/Cmds.hs
... ...
@@ -0,0 +1,112 @@
  1
+module Cmds
  2
+  ( OToolOutput
  3
+  
  4
+  , libNm
  5
+  , libUses
  6
+  
  7
+  , cmdOTool
  8
+  , cmdCP
  9
+  , cmdChmod
  10
+  ) where
  11
+
  12
+-------------------------------------------------------------------------
  13
+-- Imports
  14
+-------------------------------------------------------------------------
  15
+
  16
+import           Data.Lens.Common
  17
+import           Data.Lens.Template
  18
+import           Data.Lens.Strict
  19
+import           Data.Typeable
  20
+import           Data.List
  21
+
  22
+import           Control.DeepSeq
  23
+
  24
+import           Control.Monad
  25
+-- import           Control.Monad.State.Strict
  26
+import           Control.Monad.Trans
  27
+-- import           Control.Monad.Error.Class
  28
+
  29
+import qualified Control.Exception as CE
  30
+
  31
+-- import           System.Console.GetOpt
  32
+-- import           System.Environment
  33
+import           System.IO
  34
+-- import           System.Exit
  35
+import           System.FilePath
  36
+-- import           System.Directory
  37
+-- import           System.Cmd
  38
+import           System.Process
  39
+-- import           System.Posix.Process
  40
+
  41
+import           Opts
  42
+import           State
  43
+
  44
+-------------------------------------------------------------------------
  45
+-- Cmd run
  46
+-------------------------------------------------------------------------
  47
+
  48
+showCmdSpec (ShellCommand  s) = s
  49
+showCmdSpec (RawCommand f as) = concat $ intersperse " " (f:as)
  50
+
  51
+cmdRunPlain :: Opts -> CreateProcess -> IO ()
  52
+cmdRunPlain opts p = do
  53
+  when (opts ^. optVerbose) (putStrLn (showCmdSpec $ cmdspec p))
  54
+  createProcess p
  55
+  return ()
  56
+
  57
+cmdRunOutputPipe :: Opts -> CreateProcess -> IO Handle
  58
+cmdRunOutputPipe opts p = do
  59
+  when (opts ^. optVerbose) (putStrLn (showCmdSpec $ cmdspec p))
  60
+  (_, Just hout, _, _) <- createProcess (p {std_out = CreatePipe})
  61
+  return hout
  62
+
  63
+-------------------------------------------------------------------------
  64
+-- otool
  65
+-------------------------------------------------------------------------
  66
+
  67
+data OToolOutput = OToolOutput
  68
+  { _libNm			:: !FilePath
  69
+  , _libUses		:: ![FilePath]
  70
+  }
  71
+  deriving (Show,Typeable)
  72
+
  73
+instance NFData OToolOutput where
  74
+  rnf (OToolOutput n u) = rnf n `seq` rnf u
  75
+
  76
+makeLens ''OToolOutput
  77
+
  78
+parseOToolOutput :: String -> OToolOutput
  79
+parseOToolOutput s = OToolOutput (takeWhile (/= ':') $ head lib) (map head uses)
  80
+  where (lib:uses) = filter (not . null) $ map words $ lines s
  81
+
  82
+otoolOutputFilterOutUnwanted :: Opts -> OToolOutput -> OToolOutput
  83
+otoolOutputFilterOutUnwanted opts = libUses ^%= filter (\f -> okExt f && okLoc f)
  84
+  where okExt f = takeExtension f `elem` opts ^. optIncludeExtensions
  85
+        okLoc f = not $ any (`isPrefixOf` f) $ opts ^. optExcludePrefixes
  86
+
  87
+cmdOTool :: FilePath -> StRun OToolOutput
  88
+cmdOTool f = do
  89
+  opts <- access opts
  90
+  liftIO $ do
  91
+    hout <- cmdRunOutputPipe opts $ proc "otool" ["-L", f]
  92
+    o <- fmap (otoolOutputFilterOutUnwanted opts . parseOToolOutput) $ hGetContents hout
  93
+    o `deepseq` hClose hout
  94
+    return o
  95
+
  96
+-------------------------------------------------------------------------
  97
+-- cp
  98
+-------------------------------------------------------------------------
  99
+
  100
+cmdCP :: String -> FilePath -> FilePath -> StRun ()
  101
+cmdCP o fFr fTo = do
  102
+  opts <- access opts
  103
+  liftIO $ cmdRunPlain opts $ proc "cp" [o, fFr, fTo]
  104
+
  105
+-------------------------------------------------------------------------
  106
+-- chmod
  107
+-------------------------------------------------------------------------
  108
+
  109
+cmdChmod :: String -> FilePath -> StRun ()
  110
+cmdChmod m f = do
  111
+  opts <- access opts
  112
+  liftIO $ cmdRunPlain opts $ proc "chmod" [m, f]
69  src/LibDepGraph.hs
... ...
@@ -0,0 +1,69 @@
  1
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
  2
+
  3
+module LibDepGraph
  4
+  ( LibDepGraph
  5
+  , initLibDepGraph
  6
+  
  7
+  , ldepRoot
  8
+  , ldepGraph
  9
+  , ldepSymLinks
  10
+  
  11
+  , ldepResolveSymlink
  12
+  )
  13
+  where
  14
+
  15
+-------------------------------------------------------------------------
  16
+-- Imports
  17
+-------------------------------------------------------------------------
  18
+
  19
+import           Data.Lens.Common
  20
+import           Data.Lens.Template
  21
+-- import           Data.Graph.GraphVisit
  22
+import qualified Data.Map as Map
  23
+import           Data.Typeable
  24
+-- import qualified Data.Set as Set
  25
+
  26
+-- import           Control.Monad
  27
+-- import           Control.Monad.State.Strict
  28
+-- import           Control.Monad.Trans
  29
+-- import           Control.Monad.Error.Class
  30
+
  31
+-- import qualified Control.Exception as CE
  32
+
  33
+-- import           System.Console.GetOpt
  34
+-- import           System.Environment
  35
+-- import           System.IO
  36
+-- import           System.Exit
  37
+-- import           System.FilePath
  38
+-- import           System.Directory
  39
+-- import           System.Cmd
  40
+-- import           System.Process
  41
+-- import           System.Posix.Process
  42
+
  43
+-- import           Opts
  44
+-- import           State
  45
+import           Cmds (OToolOutput)
  46
+
  47
+-------------------------------------------------------------------------
  48
+-- Library dependency graph
  49
+-------------------------------------------------------------------------
  50
+
  51
+data LibDepGraph = LibDepGraph
  52
+  { _ldepRoot		:: FilePath
  53
+  , _ldepGraph		:: Map.Map FilePath OToolOutput
  54
+  , _ldepSymLinks	:: Map.Map FilePath FilePath
  55
+  }
  56
+  deriving (Show,Typeable)
  57
+
  58
+initLibDepGraph :: FilePath -> LibDepGraph
  59
+initLibDepGraph f = LibDepGraph f Map.empty Map.empty
  60
+
  61
+makeLens ''LibDepGraph
  62
+
  63
+-------------------------------------------------------------------------
  64
+-- Resolve symlink via LibDepGraph
  65
+-------------------------------------------------------------------------
  66
+
  67
+-- | Resolve symlink via LibDepGraph
  68
+ldepResolveSymlink :: LibDepGraph -> FilePath -> FilePath
  69
+ldepResolveSymlink ldep fnm = maybe fnm (ldepResolveSymlink ldep) $ Map.lookup fnm $ ldep ^. ldepSymLinks
177  src/MakeStandalone.hs
... ...
@@ -0,0 +1,177 @@
  1
+module Main where
  2
+
  3
+-------------------------------------------------------------------------
  4
+-- Imports
  5
+-------------------------------------------------------------------------
  6
+
  7
+import           Data.Lens.Common
  8
+import           Data.Graph.GraphVisit
  9
+import qualified Data.Map as Map
  10
+import qualified Data.Set as Set
  11
+import qualified Data.Sequence as Seq
  12
+
  13
+import           Control.Monad
  14
+import           Control.Monad.State.Strict
  15
+import           Control.Monad.Trans
  16
+import           Control.Monad.Error.Class
  17
+
  18
+import qualified Control.Exception as CE
  19
+
  20
+import           System.Console.GetOpt
  21
+import           System.Environment
  22
+import           System.IO
  23
+import           System.Exit
  24
+import           System.FilePath
  25
+import           System.Directory
  26
+import           System.Cmd
  27
+import           System.Process
  28
+import           System.Posix.Process
  29
+import           System.Posix.Files
  30
+
  31
+import           Opts
  32
+import           State
  33
+import           Cmds
  34
+import           LibDepGraph
  35
+import           Plan
  36
+
  37
+-------------------------------------------------------------------------
  38
+-- Main
  39
+-------------------------------------------------------------------------
  40
+
  41
+main :: IO ()
  42
+main = do
  43
+  args <- getArgs
  44
+  progName <- getProgName
  45
+
  46
+  let optsInit = optProgName ^= progName $ defaultOpts
  47
+      oo@(o,n,errs)  = getOpt Permute cmdLineOpts args
  48
+      opts           = foldr ($) optsInit o
  49
+
  50
+  case (errs, opts ^. optImmediateCommands, n) of
  51
+    (es@(_:_),_       ,_    ) -> forM_ es (hPutStr stderr)
  52
+    (_       ,os@(_:_),_    ) -> forM_ os (handleImmediateCommand opts)
  53
+    (_       ,_       ,[fnm]) -> doIt opts fnm
  54
+    _                         -> do handleImmediateCommand opts ImmediateCommand_Help
  55
+                                    exitFailure
  56
+
  57
+doIt :: Opts -> FilePath -> IO ()
  58
+doIt opts fnmApp = do
  59
+  pid <- getProcessID
  60
+  tmpdir <- getTemporaryDirectory
  61
+  let st  = initSt opts (RunEnv tmpdir pid fnm)
  62
+  flip evalStateT st $
  63
+    catchError (do { thework ; cleanup })
  64
+               handleerr
  65
+ where
  66
+  fnm = fpathOfExec opts fnmApp
  67
+  thework = do
  68
+    ldep <- otoolGraphVisit2LibDepGraph fnm
  69
+    when (opts ^. optVerbose) (liftIO $ putStrLn (show ldep))
  70
+    let plan = ldepGraph2Plan opts fnmApp ldep
  71
+    when (opts ^. optVerbose) (liftIO $ forM_ (seqToList plan) (putStrLn . show))
  72
+    return ()
  73
+    -- f <- srFreshTmpName
  74
+    -- liftIO $ putStrLn f
  75
+  cleanup = srRmFilesToRm
  76
+  handleerr (e :: CE.IOException) = do
  77
+    liftIO $ hPutStrLn stderr (show fnm ++ ": " ++ show e)
  78
+    cleanup
  79
+
  80
+-------------------------------------------------------------------------
  81
+-- Immediate command handling
  82
+-------------------------------------------------------------------------
  83
+
  84
+-- | Handle an immediate command
  85
+handleImmediateCommand :: Opts -> ImmediateCommand -> IO ()
  86
+handleImmediateCommand opts ImmediateCommand_Help = putStrLn (usageInfo ("Usage: " ++ opts ^. optProgName ++ " [options] <mac app>\n\noptions:") cmdLineOpts)
  87
+
  88
+-------------------------------------------------------------------------
  89
+-- Graph walk over the results provided by otool, gathering the library dependency graph
  90
+-------------------------------------------------------------------------
  91
+
  92
+otoolGraphVisit2LibDepGraph :: FilePath -> StRun LibDepGraph
  93
+otoolGraphVisit2LibDepGraph f = fmap fst $ graphVisitM visit (Set.singleton f) () (initLibDepGraph f)
  94
+  where visit t _ fnm = do
  95
+          o <- cmdOTool fnm
  96
+          (fnm', links) <- liftIO $ symlinkResolve fnm
  97
+          return
  98
+            ( ldepSymLinks ^%= Map.union (Map.fromList [ (l,fnm') | l <- links ])
  99
+              $ ldepGraph ^%= Map.insert fnm' o
  100
+              $ t
  101
+            , Set.fromList $ o ^. libUses
  102
+            )
  103
+
  104
+-------------------------------------------------------------------------
  105
+-- Graph walk over the library dependency graph, constructing the modification plan
  106
+-------------------------------------------------------------------------
  107
+
  108
+-- ldepGraphVisit2Plan :: LibDepGraph -> StRun Plan
  109
+
  110
+-------------------------------------------------------------------------
  111
+-- Compute the modification plan
  112
+-------------------------------------------------------------------------
  113
+
  114
+ldepGraph2Plan :: Opts -> FilePath -> LibDepGraph -> Plan
  115
+ldepGraph2Plan opts fnmApp ldep =
  116
+  Seq.fromList
  117
+    [ PlanCmd_CP o n | (n,((o:_),_)) <- Map.toList filesToCopy ]
  118
+  Seq.><
  119
+    foldr (Seq.><) Seq.empty
  120
+      [ Seq.fromList $
  121
+          PlanCmd_IntlRename n o ri
  122
+          : [ PlanCmd_ModfRef n u rr
  123
+            | u <- maybe [] (^. libUses) $ Map.lookup o $ ldep ^. ldepGraph
  124
+            , let u2 = ldepResolveSymlink ldep u
  125
+                  rr = Map.findWithDefault u2 u2 filesToCopyRev
  126
+            ]
  127
+      | (n,((o:_),ri)) <- Map.toList filesToCopy
  128
+      ]
  129
+ where
  130
+  filesToCopy = Map.fromListWith (\(l1,r1) (l2,_) -> (l1++l2,r1))
  131
+    [ (n, ([l'],r))
  132
+    | l <- Set.toList $ Set.delete (ldep ^. ldepRoot) $ Map.keysSet $ ldep ^. ldepGraph
  133
+    , let l' = l -- ldepResolveSymlink ldep l
  134
+          (n,r) = fpathOfNewLib opts fnmApp l'
  135
+    ]
  136
+  filesToCopyRev = Map.fromList [ (o,r) | (n,(os,r)) <- Map.toList filesToCopy, o <- os ]
  137
+
  138
+-------------------------------------------------------------------------
  139
+-- File name manipulation
  140
+-------------------------------------------------------------------------
  141
+
  142
+-- | Given app bundle name, return the location of the executable
  143
+fpathOfExec :: Opts -> FilePath -> FilePath
  144
+fpathOfExec opts fnm = fnm </> opts ^. optInAppLocOfExec </> f
  145
+  where (df,e) = splitExtension fnm
  146
+        (d,f)  = splitFileName df
  147
+
  148
+-- | Given app bundle name, return the location of the new lib loc plus new name as it is to be used for referring to
  149
+fpathOfNewLib :: Opts -> FilePath -> FilePath -> (FilePath,FilePath)
  150
+fpathOfNewLib opts fnmApp fnmLib =
  151
+  ( fnmApp </> opts ^. optInAppCpLocOfLibDest </> fl
  152
+  , opts ^. optInAppRenameLocOfLibDest </> fl
  153
+  )
  154
+ where
  155
+  (_,fl) = splitFileName fnmLib
  156
+
  157
+-- | Normalise path, on top of normal normalise also remove ".."
  158
+fpathNormalise :: FilePath -> FilePath
  159
+fpathNormalise fnm = joinPath $ reverse $ n [] $ splitDirectories $ normalise fnm
  160
+  where n (_:acc) ("..":f) = n    acc  f
  161
+        n acc     (x   :f) = n (x:acc) f
  162
+        n acc     []       =      acc
  163
+
  164
+-------------------------------------------------------------------------
  165
+-- Symbolic link resolution
  166
+-------------------------------------------------------------------------
  167
+
  168
+-- | Possibly resolve symbolic link, returning the actual filename + symlinks to it
  169
+symlinkResolve :: FilePath -> IO (FilePath, [FilePath])
  170
+symlinkResolve fnm = do
  171
+  stat <- getSymbolicLinkStatus fnm
  172
+  -- putStrLn $ fnm ++ ": " ++ show (isSymbolicLink stat)
  173
+  if isSymbolicLink stat
  174
+    then do fnmLinkedTo <- fmap (fpathNormalise . (takeDirectory fnm </>)) $ readSymbolicLink fnm
  175
+            (fnm',links) <- symlinkResolve fnmLinkedTo
  176
+            return (fnm', fnm : links)
  177
+    else return (fnm, [])
85  src/Opts.hs
... ...
@@ -0,0 +1,85 @@
  1
+module Opts
  2
+  ( ImmediateCommand(..)
  3
+  
  4
+  , Opts
  5
+  
  6
+  , optImmediateCommands
  7
+  , optVerbose
  8
+  , optProgName
  9
+  , optExcludePrefixes
  10
+  , optIncludeExtensions
  11
+  , optInAppLocOfExec			
  12
+  , optInAppCpLocOfLibDest		
  13
+  , optInAppRenameLocOfLibDest
  14
+
  15
+
  16
+  , defaultOpts
  17
+  , cmdLineOpts
  18
+  ) where
  19
+
  20
+-------------------------------------------------------------------------
  21
+-- Imports
  22
+-------------------------------------------------------------------------
  23
+
  24
+import           Data.Lens.Common
  25
+import           Data.Lens.Template
  26
+import           Data.Typeable
  27
+
  28
+import           System.Console.GetOpt
  29
+
  30
+-------------------------------------------------------------------------
  31
+-- Immediate commands
  32
+-------------------------------------------------------------------------
  33
+
  34
+-- | Immediate command, that is, being done before actually doing the work of the program
  35
+data ImmediateCommand
  36
+  = ImmediateCommand_Help
  37
+
  38
+-------------------------------------------------------------------------
  39
+-- Options
  40
+-------------------------------------------------------------------------
  41
+
  42
+-- | Options
  43
+data Opts 
  44
+  = Opts
  45
+      { _optVerbose					::	Bool					-- ^ be verbose
  46
+      , _optImmediateCommands		::	[ImmediateCommand]		-- ^ e.g. help
  47
+      , _optProgName				::	String					-- ^ the name of this program
  48
+      , _optExcludePrefixes			::	[FilePath]				-- ^ prefixes of locations which may not be copied
  49
+      , _optIncludeExtensions		::	[String]				-- ^ extensions which must be copied (if outside)
  50
+      , _optInAppLocOfExec			::  FilePath				-- ^ relative location of executable in app bundle
  51
+      , _optInAppCpLocOfLibDest		::  FilePath				-- ^ relative location of where copied libraries should end up in app bundle
  52
+      , _optInAppRenameLocOfLibDest	::  FilePath				-- ^ relative location of where to renaming should be done in app bundle
  53
+      }
  54
+    deriving (Typeable)
  55
+
  56
+-- dylibbundler -od -b -x ./Dazzle.app/Contents/MacOS/Dazzle -d ./Dazzle.app/Contents/libs/ -p @executable_path/../libs/
  57
+
  58
+makeLens ''Opts
  59
+
  60
+defaultOpts 
  61
+  = Opts
  62
+      { _optVerbose					=	False
  63
+      , _optImmediateCommands		=	[]
  64
+      , _optProgName				=	"??"
  65
+      , _optExcludePrefixes			=   [ "/usr/lib" 
  66
+      									, "/System/Library/Frameworks"
  67
+      									]
  68
+      , _optIncludeExtensions		=   [ ".dylib" 
  69
+      									]
  70
+      , _optInAppLocOfExec			=	"Contents/MacOS"
  71
+      , _optInAppCpLocOfLibDest		=	"Contents/lib"
  72
+      , _optInAppRenameLocOfLibDest	=	"@executable_path/../lib"
  73
+      }
  74
+
  75
+-------------------------------------------------------------------------
  76
+-- Cmdline opts
  77
+-------------------------------------------------------------------------
  78
+
  79
+cmdLineOpts
  80
+  =  [  Option ""   ["help"]            			(NoArg $ optImmediateCommands ^%= ([ImmediateCommand_Help] ++))
  81
+          "output this help"
  82
+     ,  Option "v"  ["verbose"]            			(NoArg $ optVerbose ^= True)
  83
+          "be verbose"
  84
+     ]
  85
+
87  src/Plan.hs
... ...
@@ -0,0 +1,87 @@
  1
+module Plan
  2
+  ( PlanCmd(..)
  3
+  , Plan
  4
+  
  5
+  , planCmdExec
  6
+  
  7
+  , seqToList
  8
+  )
  9
+  where
  10
+
  11
+-------------------------------------------------------------------------
  12
+-- Imports
  13
+-------------------------------------------------------------------------
  14
+
  15
+import           Data.Lens.Common
  16
+import           Data.Lens.Template
  17
+-- import           Data.Graph.GraphVisit
  18
+-- import qualified Data.Map as Map
  19
+import           Data.Sequence
  20
+import           Data.Typeable
  21
+-- import qualified Data.Set as Set
  22
+
  23
+-- import           Control.Monad
  24
+-- import           Control.Monad.State.Strict
  25
+-- import           Control.Monad.Trans
  26
+-- import           Control.Monad.Error.Class
  27
+
  28
+-- import qualified Control.Exception as CE
  29
+
  30
+-- import           System.Console.GetOpt
  31
+-- import           System.Environment
  32
+-- import           System.IO
  33
+-- import           System.Exit
  34
+-- import           System.FilePath
  35
+-- import           System.Directory
  36
+-- import           System.Cmd
  37
+-- import           System.Process
  38
+-- import           System.Posix.Process
  39
+
  40
+import           Opts
  41
+import           State
  42
+import           Cmds
  43
+
  44
+-------------------------------------------------------------------------
  45
+-- Execution plan for modification commands
  46
+-------------------------------------------------------------------------
  47
+
  48
+data PlanCmd
  49
+  = PlanCmd_CP							-- ^ Copy file
  50
+      { _pcFrom		:: FilePath
  51
+      , _pcTo		:: FilePath
  52
+      }
  53
+  | PlanCmd_ModfRef						-- ^ Modify ref in file
  54
+      { _pcInFile	:: FilePath
  55
+      , _pcFrom		:: FilePath
  56
+      , _pcTo		:: FilePath
  57
+      }
  58
+  | PlanCmd_IntlRename					-- ^ Modify internal name in file
  59
+      { _pcInFile	:: FilePath
  60
+      , _pcFrom		:: FilePath
  61
+      , _pcTo		:: FilePath
  62
+      }
  63
+  deriving (Show,Typeable)
  64
+
  65
+makeLens ''PlanCmd
  66
+
  67
+type Plan = Seq PlanCmd
  68
+
  69
+-------------------------------------------------------------------------
  70
+-- Actual execution
  71
+-------------------------------------------------------------------------
  72
+
  73
+planCmdExec :: PlanCmd -> StRun ()
  74
+planCmdExec pcmd = case pcmd of
  75
+  PlanCmd_CP fFr fTo -> do cmdCP "-f" fFr fTo
  76
+                           cmdChmod "+w" fTo
  77
+  _ -> return ()
  78
+
  79
+-------------------------------------------------------------------------
  80
+-- Seq extension
  81
+-------------------------------------------------------------------------
  82
+
  83
+seqToList :: Seq a -> [a]
  84
+seqToList s = case viewl s of
  85
+  EmptyL -> []
  86
+  hd :< tl -> hd : seqToList tl
  87
+  
103  src/State.hs
... ...
@@ -0,0 +1,103 @@
  1
+module State
  2
+  ( ImmediateCommand(..)
  3
+  
  4
+  , RunEnv(RunEnv)
  5
+
  6
+  , State
  7
+  , initSt
  8
+
  9
+  , opts
  10
+  , pid
  11
+  
  12
+  , StRun
  13
+  
  14
+  , srRmFilesToRm
  15
+  , srFreshTmpName
  16
+  , srRegisterFileForRm
  17
+  ) where
  18
+
  19
+-------------------------------------------------------------------------
  20
+-- Imports
  21
+-------------------------------------------------------------------------
  22
+
  23
+import           Data.Lens.Common
  24
+import           Data.Lens.Template
  25
+import           Data.Lens.Strict
  26
+import           Data.Typeable
  27
+-- import qualified Data.Set as Set
  28
+
  29
+import           Control.Monad.State.Strict
  30
+import qualified Control.Exception as CE
  31
+
  32
+import           System.Posix.Types
  33
+import           System.FilePath
  34
+import           System.IO
  35
+-- import           System.IO.Temp
  36
+import           System.Directory
  37
+
  38
+import           Opts
  39
+
  40
+-------------------------------------------------------------------------
  41
+-- Bits of info about runtime env
  42
+-------------------------------------------------------------------------
  43
+
  44
+data RunEnv = RunEnv
  45
+  { _tmpdir		:: FilePath
  46
+  , _pid		:: ProcessID
  47
+  , _argFile	:: FilePath
  48
+  }
  49
+  deriving Typeable
  50
+
  51
+makeLens ''RunEnv
  52
+
  53
+-------------------------------------------------------------------------
  54
+-- State
  55
+-------------------------------------------------------------------------
  56
+
  57
+data St = St
  58
+  { _opts		:: Opts
  59
+  , _runEnv		:: RunEnv
  60
+  , _uniq		:: Int
  61
+  , _filesToRm	:: [FilePath]
  62
+  }
  63
+  deriving Typeable
  64
+
  65
+initSt :: Opts -> RunEnv -> St
  66
+initSt o e = St o e 0 []
  67
+
  68
+makeLens ''St
  69
+
  70
+-------------------------------------------------------------------------
  71
+-- St monad
  72
+-------------------------------------------------------------------------
  73
+
  74
+type StRun a = StateT St IO a
  75
+
  76
+-- | get a fresh uniq nr
  77
+srFreshUniq :: StRun Int
  78
+srFreshUniq = do
  79
+  i <- access uniq
  80
+  uniq += 1
  81
+  return i
  82
+
  83
+-- | register file for removal
  84
+srRegisterFileForRm :: FilePath -> StRun [FilePath]
  85
+srRegisterFileForRm f = filesToRm %= ([f]++)
  86
+
  87
+-- | remove all files registered for removal
  88
+srRmFilesToRm :: StRun ()
  89
+srRmFilesToRm = do
  90
+  files <- filesToRm %%= (\f -> (f,[]))
  91
+  liftIO $ forM_ files rm
  92
+ where rm f = CE.catch (removeFile f)
  93
+                       (\(e :: CE.SomeException) -> hPutStrLn stderr (show f ++ ": " ++ show e))
  94
+
  95
+-- | get a fresh tmp filename
  96
+srFreshTmpName :: StRun FilePath
  97
+srFreshTmpName = do
  98
+  i <- srFreshUniq
  99
+  e <- access runEnv
  100
+  let t = e ^. tmpdir </> takeBaseName (e ^. argFile)  ++ "-" ++ show (e ^. pid) ++ "-" ++ show i
  101
+  srRegisterFileForRm t
  102
+  return t
  103
+
6  test
... ...
@@ -0,0 +1,6 @@
  1
+#!/bin/sh
  2
+
  3
+m=dist/build/macosx-make-standalone/macosx-make-standalone
  4
+
  5
+${m} /Volumes/Work/Programming/project.bayes.dazzle/trunk/Dazzle/Dazzle.app -v
  6
+#${m} ${m}

0 notes on commit d2f1735

Please sign in to comment.
Something went wrong with that request. Please try again.