boomange-0.1.3.0: Main.hs
{-
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.0"
-- 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)
{-
separateConfigs [] = ([],[])
separateConfigs (h:r) =
let (actions, configs) = separateConfigs r in
case h of
ConfigFile x -> (actions, x : configs)
other -> (other : actions, configs)
-}
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
{-
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
let cFile = cDir ++ "/config"
config <- loadConfig cFile
generateBookmarks config
-}