Resources.hs 3.36 KB
Newer Older
1
2
3
4
5
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
module Resources
  ( extractResources
  , getResourceString
  , deckerResourceDir
6
  , writeExampleProject
7
  , copyDir
8
  , getOldResources
9
10
11
12
13
  ) where

import Common
import Control.Exception
import Control.Monad
Henrik Tramberend's avatar
Henrik Tramberend committed
14
import Control.Monad.Extra
15
import Exception
16
import System.Directory
Henrik Tramberend's avatar
Henrik Tramberend committed
17
import System.Environment
18
import System.Exit
19
import System.FilePath
20
import System.Process
21
import Text.Regex.TDFA
22
23

deckerResourceDir :: IO FilePath
24
25
26
deckerResourceDir =
  getXdgDirectory
    XdgData
27
28
    ("decker" ++
     "-" ++ deckerVersion ++ "-" ++ deckerGitBranch ++ "-" ++ deckerGitCommitId)
29

30
31
32
33
34
35
36
getOldResources :: IO [FilePath]
getOldResources = do
  dir <- takeDirectory <$> deckerResourceDir
  files <- listDirectory dir
  return $ map (dir </>) $ filter oldVersion files
  where
    current = deckerVersion
37
    deckerRegex = "decker-([0-9]+[.][0-9]+[.][0-9]+)-" :: String
38
39
40
    oldVersion name =
      case getAllTextSubmatches (name =~ deckerRegex) :: [String] of
        [] -> False
41
        _:v:vs -> v < current
42

43
44
45
getResourceString :: FilePath -> IO String
getResourceString path = do
  dataDir <- deckerResourceDir
46
  readFile (dataDir </> path)
47
48
49
50
51
52
53
54

-- Extract resources from the executable into the XDG data directory.
extractResources :: IO ()
extractResources = do
  deckerExecutable <- getExecutablePath
  dataDir <- deckerResourceDir
  exists <- doesDirectoryExist dataDir
  unless exists $ do
55
56
    unlessM (Resources.unzip ["-l", deckerExecutable]) $
      throw $ ResourceException "No resource zip found in decker executable."
57
    createDirectoryIfMissing True dataDir
58
    unlessM (Resources.unzip ["-qq", "-o", "-d", dataDir, deckerExecutable]) $
59
60
61
62
63
64
65
66
      throw $
      ResourceException "Unable to extract resources from decker executable"
    putStrLn $ "# resources extracted to " ++ dataDir

unzip :: [String] -> IO Bool
unzip args = do
  (exitCode, _, _) <- readProcessWithExitCode "unzip" args ""
  return $
67
    case exitCode of
68
69
70
      ExitSuccess -> True
      ExitFailure 1 -> True
      _ -> False
71

72
-- | Write the example project to the current folder
73
writeExampleProject :: IO ()
74
writeExampleProject = writeResourceFiles "example" "."
75

76
77
78
79
writeResourceFiles :: FilePath -> FilePath -> IO ()
writeResourceFiles prefix destDir = do
  dataDir <- deckerResourceDir
  let src = dataDir </> prefix
80
  copyDir src destDir
81

82
-- | Copy a file to a file location or to a directory
83
84
85
86
cp :: FilePath -> FilePath -> IO ()
cp src dst = do
  unlessM (doesFileExist src) $
    throw (userError "src does not exist or is not a file")
87
88
89
90
91
  unlessM (doesFileExist dst) $ do
    destIsDir <- doesDirectoryExist dst
    if destIsDir
      then copyFile src (dst </> takeFileName src)
      else copyFile src dst
92

93
-- | Copy a directory and its contents recursively
94
95
copyDir :: FilePath -> FilePath -> IO ()
copyDir src dst = do
96
97
98
99
100
101
102
  unlessM (doesDirectoryExist src) $
    throw (userError "src does not exist or is not a directory")
  dstExists <- doesDirectoryExist dst
  if dstExists && (last (splitPath src) /= last (splitPath dst))
    then copyDir src (dst </> last (splitPath src))
    else do
      createDirectoryIfMissing True dst
103
104
      contents <- listDirectory src
      forM_ contents $ \name -> do
105
106
107
108
109
110
        let srcPath = src </> name
        let dstPath = dst </> name
        isDirectory <- doesDirectoryExist srcPath
        if isDirectory
          then copyDir srcPath dstPath
          else cp srcPath dstPath