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
|
{- |
Module : Pancake.Configuration
Maintainer : defanor <defanor@uberspace.net>
Stability : unstable
Portability : non-portable (GHC extensions are used)
Pancake configuration facilities.
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Pancake.Configuration ( Config(..)
, loadConfig
) where
import Data.Yaml
import Data.Default
import Control.Monad.State
import System.Directory
import System.FilePath
import qualified Data.Map as M
import GHC.Generics
import Pancake.Common
-- | Application configuration.
data Config = Config { commands :: M.Map String String
-- ^ URI schemes and corresponding shell commands
-- for downloading.
, defaultCommand :: String
-- ^ A command to use if no other command
-- applies.
, externalViewers :: M.Map String String
-- ^ File extensions and corresponding external
-- applications.
, shortcuts :: M.Map String String
-- ^ Shortcuts to use (search engines,
-- dictionaries, etc).
, paginate :: Bool
-- ^ Enable pagination in non-embedded mode;
-- print everything at once otherwise.
, historyDepth :: Int
-- ^ The amount of history entries (into either
-- direction) to keep.
} deriving (Generic, Show)
-- | For configuration parsing.
instance FromJSON Config
-- | For configuration writing, particularly that of default
-- configuration if it is missing.
instance ToJSON Config
-- | The default configuration to use if user configuration is
-- missing.
instance Default Config where
def = Config {
commands = M.fromList
[ ("ssh", "scp \"${URI_REGNAME}:${URI_PATH}\" /dev/stdout")
, ("gopher", "curl \"${URI}\"")]
, defaultCommand = "curl -4 -L \"${URI}\""
, externalViewers = M.fromList $
map (flip (,) "emacsclient -n \"${FILE}\"")
["hs", "cabal", "c", "h", "el", "scm", "idr"]
++ map (flip (,) "xdg-open \"${FILE}\"")
[ "svg", "png", "jpg", "jpeg", "gif", "pdf", "ogg", "ogv"
, "webm", "mp3", "mp4", "mkv", "mpeg", "wav" ]
, shortcuts = M.fromList
[ ("ddg", "https://duckduckgo.com/lite/?q=")
, ("wp", "https://en.m.wikipedia.org/wiki/Special:Search?search=")
, ("wt", "https://en.m.wiktionary.org/w/index.php?search=")
, ("gp", "gopher://gopherpedia.com:70/7/lookup?")
, ("vs", "gopher://gopher.floodgap.com/7/v2/vs?")]
, paginate = True
, historyDepth = 100
}
-- | Loads configuration from an XDG config directory.
loadConfig :: MonadIO m => m Config
loadConfig = liftIO $ do
dir <- getXdgDirectory XdgConfig "pancake"
createDirectoryIfMissing True dir
let configPath = dir </> "config.yaml"
exists <- doesFileExist configPath
if exists
then do
c <- decodeFile configPath
case c of
Just config -> pure config
Nothing -> putErrLn "Failed to read the configuration, using defaults"
>> pure def
else encodeFile configPath (def :: Config) >> pure def
|
