summaryrefslogtreecommitdiff
path: root/Main.hs
blob: 8e5ce75b1ea7cee039a94143019f343d39aa61b9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
{-
	Copyright 2013,2014 Marcelo Millani

	This file is part of boomange.

    boomange 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 3 of the License, or
    (at your option) any later version.

    boomange 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 boomange.  If not, see <http://www.gnu.org/licenses/>
-}

import Control.Exception
import Control.Monad
import System.IO
import System.Directory
import System.Environment
import System.FilePath
import Data.List
import Text.Printf
import Data.Tree

import Paths_boomange -- automatically generated

import Data.DescriLo as DescriLo
import Data.Simtreelo as Simtreelo

import Data.Builder
import Data.Entities hiding (name)
import Data.Loader

appName = "boomange"
appVersion = "0.1.3.5"
-- header to be used on the sample config file
configHeader =
  "# This is the configuration file for " ++ appName ++ "\n" ++
  "# For a full description of its syntax, see the haddock documentation of DescriLo\n" ++
  "# In the config description:\n" ++
  "# output - where should the resulting html file be placed\n" ++
  "# header - file to be prepended to output\n" ++
  "# footer - file to be appended to output\n" ++
  "# there are no other values for config\n\n" ++
  "# In the watch description, there may be an unlimited amount of values and the left part is always ignored by the program and may be used for organization.\n" ++
  "# The right part indicates which file will be read to create the output. It will behave as if all of the files were concatenated.\n\n"

-- header to be used on the sample bookmarks file
bookmarksHeader =
  "#\n" ++
  "# This is a sample bookmarks file for " ++ appName ++ "\n" ++
  "# For a full description of its syntax, see the haddock documentation for SimtreeLo\n" ++
  "# The first line indicates the comment pattern" ++
  "# Leaves represent the URI of their direct parents\n"

generateBookmarks config = do
  header <- readFile $ headerFile config
  footer <- readFile $ footerFile config
  final <- openFile (outputFile config) WriteMode

  bookmarks <- loadBookmarks $ watch config
  let body = htmlBookmarks bookmarks
  hPutStr final header
  hPutStr final body
  hPutStr final footer
  hClose final

  printf "Output written to %s\n" (outputFile config)

-- | gets the directory where configuration files should be placed
--
-- First, checks if XDG_CONFIG_HOME exists, producing $XDG_CONFIG_HOME/appName if it does
-- if it does not, the checks if HOME does, producing $HOME/.config/appName if it does
-- if it still fails, returns getAppUserDataDirectory appName
getConfigDirectory appName =
  let failXDG e = do
        dir <- getEnv "HOME"
        return $ dir ++ [pathSeparator] ++ ".config" ++ [pathSeparator] ++ appName
      failHOME e = getAppUserDataDirectory appName
  in
   do
     handle (failHOME::SomeException -> IO FilePath) $
       handle (failXDG::SomeException -> IO FilePath) $ do
         dir <- getEnv "XDG_CONFIG_HOME"
         return $ dir ++ [pathSeparator] ++ appName

-- | installs a basic configuration
installConfig cDir =
  let htmlDir = cDir ++ [pathSeparator] ++ "html"
      bookFile = cDir ++ [pathSeparator] ++ "bookmarks"
      outFile = cDir ++ [pathSeparator] ++ "bookmarks.html"
      config =
        Description
        {
          name = "config"
        , values = [
            ("output",outFile)
          , ("header",htmlDir ++ [pathSeparator] ++ "header.html")
          , ("footer", htmlDir ++ [pathSeparator] ++ "footer.html")
          ]
        }

      watch =
        Description
                   {
                     name = "watch"
                   , values = [
                     ("default",bookFile)
                     ]
                   }
      sampleBookmarks =
        "Boomange\n\tDocumentation\n" ++
        "\t\tDescriLo\n\t\t\thttp://hackage.haskell.org/package/descrilo-0.1.0.0/docs/Data-DescriLo.html\n" ++
        "\t\tSimtreeLo\n\t\t\thttp://hackage.haskell.org/package/simtreelo-0.1.0.0/docs/Data-Simtreelo.html\n"

      cFile = cDir ++ [pathSeparator] ++ "config"
  in
   do
     -- creates the base config file
     hcFile <- openFile cFile WriteMode
     hPutStr hcFile configHeader
     hPutStr hcFile $ show config
     hPutStr hcFile $ show watch
     hClose hcFile

     -- copies the default html files
     headerFile <- getDataFileName "html/header.html"
     footerFile <- getDataFileName "html/footer.html"
     cssFile <- getDataFileName "style.css"
     -- creates the html folder
     createDirectoryIfMissing True htmlDir
     -- copies html files
     copyFile headerFile $ htmlDir ++ [pathSeparator] ++ "header.html"
     copyFile footerFile $ htmlDir ++ [pathSeparator] ++ "footer.html"
     -- copies css file
     copyFile cssFile $ cDir ++ [pathSeparator] ++ "style.css"

     -- creates a sample bookmarks file
     hBookmarks <- openFile bookFile WriteMode
     hPutStr hBookmarks bookmarksHeader
     hPutStr hBookmarks $ sampleBookmarks
     hClose hBookmarks

data Action = Help | ConfigFile String | Version | Status | Add String String String | Invalid String | Generate deriving Eq

parseArgs args activeConfig = case args of
  "-h":r                 -> Help : parseArgs r activeConfig
  "--help":r             -> Help : parseArgs r activeConfig
  "-c":file:r            -> ConfigFile file : parseArgs r file
  "--config":file:r      -> ConfigFile file : parseArgs r file
  "-v":r                 -> Version : parseArgs r activeConfig
  "--version":r          -> Version : parseArgs r activeConfig
  "-s":r                 -> Status : parseArgs r activeConfig
  "--status":r           -> Status : parseArgs r activeConfig
  "-a":bookmark:uri:r    -> Add bookmark uri activeConfig : parseArgs r activeConfig
  "--add":bookmark:uri:r -> Add bookmark uri activeConfig : parseArgs r activeConfig
  []                     -> []
  other:r                -> Invalid other : Help : parseArgs r activeConfig

-- | Adds a bookmark to the correct file inside the configuration file given
--
-- | The bookmark is in the form "id/path/of/bookmark", where 'id' is the identifier of the simtreelo file to which the bookmark should be added and each slash indicates a new depth in the tree. The last value should be the URI of the bookmark.
--
-- | Existing depths will be reused (i.e., duplicates will not be generated).
addBookmark bookmark uri configFile = do
  let (id, r) = span (/= '/') bookmark
  config <- DescriLo.loadDescriptionFile configFile ""
  let mwatch = find (\x -> DescriLo.name x == "watch") config
  case mwatch of
    Just watch -> let mid = find (\(x,y) -> x == id) $ DescriLo.values watch in
      case mid of
        Nothing -> printf "No bookmark file with id '%s' found in configuration file '%s'. Bookmark '%s' ignored.\n" id configFile bookmark
        -- adds the bookmark to the respective simtreelo file
        Just (foundId, treeFile) -> addBookmarkTree (tail r) uri treeFile
    Nothing -> putStr "invalid configuration file"


addBookmarkTree bookmark uri treeFile = do
  let bookmarkTree = pathToTree bookmark uri
  oldForest <- Simtreelo.loadFile treeFile
  case oldForest of
    Left error -> printf "Failed loading '%s':\n\t%s" treeFile error
    Right forest -> do
      let newTree = Simtreelo.merge forest bookmarkTree
      Simtreelo.write newTree "" "\t" treeFile
      printf "Added '%s' to '%s'.\n" uri treeFile

pathToTree path uri =
  let (label, r) = span (/= '/') path in
  Node{rootLabel = label, subForest = if r == [] then [Node{rootLabel = uri, subForest = []}] else [ pathToTree (tail r) uri ]  }

execute [] _ _ = return ()
execute (h:r) activeConfig configFiles =
  case h of
    Add bookmark uri configFile -> do
      addBookmark bookmark uri configFile
    Help -> do
      printf "usage: %s [OPTION...]\n" appName
      putStr $
        "Options:\n" ++
        "  -h, --help                     shows this help text\n" ++
        "  -c, --config <file>            uses <file> as config instead of the default\n" ++
        "  -v, --version                  outputs version and exits\n"++
        "  -s, --status                   outputs configuration file info and exits\n" ++
        "  -a, --add <location> <URI>     adds a bookmark to file with the given id.\n" ++
        "                                   The depths of <location> should be separated\n" ++
        "                                   with '/'s.\n" ++
        "                                   Example: 'id/section'\n"
    Version -> do
      printf "%s %s\n" appName appVersion
      putStr $  "Copyright (C) 2013,2014 Marcelo Garlet Millani\n" ++
        "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>.\n" ++
        "This is free software: you are free to change and redistribute it.\n" ++
        "There is NO WARRANTY, to the extent permitted by law.\n"
    Status ->
      mapM showStatus configFiles >>= mapM_ (mapM_ putStrLn)
    Invalid opt -> do
      printf "'%s' is not a valid option or has an incorrect number of arguments\n" opt
    Generate -> do
      configs <- mapM loadConfig configFiles
      mapM_ generateBookmarks configs
  >> execute r activeConfig configFiles

showStatus :: String -> IO [String]
showStatus configFile = do
  config <- loadConfig configFile
  return $ printf "%s:" configFile :
    (printf "\tOutput file:\n\t\t%s" (outputFile config)) :
    (printf "\tHeader file:\n\t\t%s" (headerFile config)) :
    (printf "\tFooter file:\n\t\t%s" (footerFile config)) :
    "\tBookmarks files:" :
    (map (\x -> "\t\t" ++ x) $ watch config)

main = do
  args <- getArgs
  let (argConfigs', argActions) = partition (\x -> case x of ConfigFile _ -> True ; _ -> False) $ parseArgs args ""
      argConfigs = map (\(ConfigFile x) -> x) argConfigs'
      -- if help, status or version were asked, does not generate bookmarks
      actions =  if elem Help argActions || elem Version argActions || elem Status argActions then argActions else (argActions ++ [Generate])
  -- if no configuration file was given, uses the default one
  configs <- if argConfigs == [] then do
    cDir <- getConfigDirectory appName
    -- if the configuration directory does not exists, sets it up
    confExists <- doesDirectoryExist cDir
    when (not confExists) $ do
      createDirectoryIfMissing True cDir
      installConfig cDir
    return $ [cDir ++ "/config"]
             else (return argConfigs)
  execute actions "" configs