{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiWayIf #-}
module Hledger.Cli.Conf (
Conf
,SectionName
,getConf
,getConf'
,nullconf
,confLookup
,activeConfFile
,activeLocalConfFile
,activeUserConfFile
,confFiles
,userConfFiles
,parseConf
)
where
import Control.Exception (handle)
import Control.Monad (void, forM)
import Control.Monad.Identity (Identity)
import Data.Functor ((<&>))
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T (pack)
import Safe (headMay, lastDef)
import System.Directory (getHomeDirectory, getXdgDirectory, XdgDirectory (XdgConfig), doesFileExist, getCurrentDirectory)
import System.FilePath ((</>), takeDirectory)
import Text.Megaparsec as M
import Text.Megaparsec.Char
import Hledger (error', strip, words', RawOpts, expandPath)
import Hledger.Read.Common
import Hledger.Utils.Parse
import Hledger.Utils.Debug
import Hledger.Data.RawOptions (collectopts)
data Conf = Conf {
Conf -> FilePath
confFile :: FilePath
,Conf -> Int
confFormat :: Int
,Conf -> [ConfSection]
confSections :: [ConfSection]
} deriving (Conf -> Conf -> Bool
(Conf -> Conf -> Bool) -> (Conf -> Conf -> Bool) -> Eq Conf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Conf -> Conf -> Bool
== :: Conf -> Conf -> Bool
$c/= :: Conf -> Conf -> Bool
/= :: Conf -> Conf -> Bool
Eq,Int -> Conf -> ShowS
[Conf] -> ShowS
Conf -> FilePath
(Int -> Conf -> ShowS)
-> (Conf -> FilePath) -> ([Conf] -> ShowS) -> Show Conf
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Conf -> ShowS
showsPrec :: Int -> Conf -> ShowS
$cshow :: Conf -> FilePath
show :: Conf -> FilePath
$cshowList :: [Conf] -> ShowS
showList :: [Conf] -> ShowS
Show)
data ConfSection = ConfSection {
ConfSection -> FilePath
csName :: SectionName
,ConfSection -> [FilePath]
csArgs :: [Arg]
} deriving (ConfSection -> ConfSection -> Bool
(ConfSection -> ConfSection -> Bool)
-> (ConfSection -> ConfSection -> Bool) -> Eq ConfSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfSection -> ConfSection -> Bool
== :: ConfSection -> ConfSection -> Bool
$c/= :: ConfSection -> ConfSection -> Bool
/= :: ConfSection -> ConfSection -> Bool
Eq,Int -> ConfSection -> ShowS
[ConfSection] -> ShowS
ConfSection -> FilePath
(Int -> ConfSection -> ShowS)
-> (ConfSection -> FilePath)
-> ([ConfSection] -> ShowS)
-> Show ConfSection
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfSection -> ShowS
showsPrec :: Int -> ConfSection -> ShowS
$cshow :: ConfSection -> FilePath
show :: ConfSection -> FilePath
$cshowList :: [ConfSection] -> ShowS
showList :: [ConfSection] -> ShowS
Show)
type SectionName = String
type Arg = String
nullconf :: Conf
nullconf = Conf {
confFile :: FilePath
confFile = FilePath
""
,confFormat :: Int
confFormat = Int
1
,confSections :: [ConfSection]
confSections = []
}
data ConfFileSpec =
SomeConfFile FilePath
| NoConfFile
| AutoConfFile
deriving (ConfFileSpec -> ConfFileSpec -> Bool
(ConfFileSpec -> ConfFileSpec -> Bool)
-> (ConfFileSpec -> ConfFileSpec -> Bool) -> Eq ConfFileSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfFileSpec -> ConfFileSpec -> Bool
== :: ConfFileSpec -> ConfFileSpec -> Bool
$c/= :: ConfFileSpec -> ConfFileSpec -> Bool
/= :: ConfFileSpec -> ConfFileSpec -> Bool
Eq,Int -> ConfFileSpec -> ShowS
[ConfFileSpec] -> ShowS
ConfFileSpec -> FilePath
(Int -> ConfFileSpec -> ShowS)
-> (ConfFileSpec -> FilePath)
-> ([ConfFileSpec] -> ShowS)
-> Show ConfFileSpec
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfFileSpec -> ShowS
showsPrec :: Int -> ConfFileSpec -> ShowS
$cshow :: ConfFileSpec -> FilePath
show :: ConfFileSpec -> FilePath
$cshowList :: [ConfFileSpec] -> ShowS
showList :: [ConfFileSpec] -> ShowS
Show)
confFileSpecFromRawOpts :: RawOpts -> ConfFileSpec
confFileSpecFromRawOpts :: RawOpts -> ConfFileSpec
confFileSpecFromRawOpts = ConfFileSpec -> [ConfFileSpec] -> ConfFileSpec
forall a. a -> [a] -> a
lastDef ConfFileSpec
AutoConfFile ([ConfFileSpec] -> ConfFileSpec)
-> (RawOpts -> [ConfFileSpec]) -> RawOpts -> ConfFileSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> Maybe ConfFileSpec)
-> RawOpts -> [ConfFileSpec]
forall a. ((FilePath, FilePath) -> Maybe a) -> RawOpts -> [a]
collectopts (FilePath, FilePath) -> Maybe ConfFileSpec
cfsFromRawOpt
where
cfsFromRawOpt :: (FilePath, FilePath) -> Maybe ConfFileSpec
cfsFromRawOpt (FilePath
"conf",FilePath
f) = ConfFileSpec -> Maybe ConfFileSpec
forall a. a -> Maybe a
Just (ConfFileSpec -> Maybe ConfFileSpec)
-> ConfFileSpec -> Maybe ConfFileSpec
forall a b. (a -> b) -> a -> b
$ FilePath -> ConfFileSpec
SomeConfFile FilePath
f
cfsFromRawOpt (FilePath
"no-conf",FilePath
_) = ConfFileSpec -> Maybe ConfFileSpec
forall a. a -> Maybe a
Just (ConfFileSpec -> Maybe ConfFileSpec)
-> ConfFileSpec -> Maybe ConfFileSpec
forall a b. (a -> b) -> a -> b
$ ConfFileSpec
NoConfFile
cfsFromRawOpt (FilePath, FilePath)
_ = Maybe ConfFileSpec
forall a. Maybe a
Nothing
confLookup :: SectionName -> Conf -> [Arg]
confLookup :: FilePath -> Conf -> [FilePath]
confLookup FilePath
cmd Conf{[ConfSection]
confSections :: Conf -> [ConfSection]
confSections :: [ConfSection]
confSections} =
[FilePath]
-> ([FilePath] -> [FilePath]) -> Maybe [FilePath] -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
words') (Maybe [FilePath] -> [FilePath]) -> Maybe [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
FilePath -> Map FilePath [FilePath] -> Maybe [FilePath]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
cmd (Map FilePath [FilePath] -> Maybe [FilePath])
-> Map FilePath [FilePath] -> Maybe [FilePath]
forall a b. (a -> b) -> a -> b
$
[(FilePath, [FilePath])] -> Map FilePath [FilePath]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FilePath
csName,[FilePath]
csArgs) | ConfSection{FilePath
csName :: ConfSection -> FilePath
csName :: FilePath
csName,[FilePath]
csArgs :: ConfSection -> [FilePath]
csArgs :: [FilePath]
csArgs} <- [ConfSection]
confSections]
getConf :: RawOpts -> IO (Either String (Conf, Maybe FilePath))
getConf :: RawOpts -> IO (Either FilePath (Conf, Maybe FilePath))
getConf RawOpts
rawopts = do
case RawOpts -> ConfFileSpec
confFileSpecFromRawOpts RawOpts
rawopts of
ConfFileSpec
NoConfFile -> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ (Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath)
forall a b. b -> Either a b
Right ((Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath))
-> (Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> (Conf, Maybe FilePath) -> (Conf, Maybe FilePath)
forall a. FilePath -> a -> a
dbg1Msg FilePath
"ignoring config files" (Conf
nullconf, Maybe FilePath
forall a. Maybe a
Nothing)
SomeConfFile FilePath
f -> IO FilePath
getCurrentDirectory IO FilePath -> (FilePath -> IO FilePath) -> IO FilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> FilePath -> IO FilePath)
-> FilePath -> FilePath -> IO FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> IO FilePath
expandPath FilePath
f IO FilePath
-> (FilePath -> IO (Either FilePath (Conf, Maybe FilePath)))
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (Either FilePath (Conf, Maybe FilePath))
readConfFile (FilePath -> IO (Either FilePath (Conf, Maybe FilePath)))
-> ShowS -> FilePath -> IO (Either FilePath (Conf, Maybe FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
forall a. Show a => FilePath -> a -> a
dbg1 FilePath
"using specified config file"
ConfFileSpec
AutoConfFile -> do
[FilePath]
fs <- IO [FilePath]
confFiles
case [FilePath]
fs of
FilePath
f:[FilePath]
_ -> FilePath -> [FilePath] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
FilePath -> a -> m ()
dbg8IO FilePath
"found config files" [FilePath]
fs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
FilePath -> a -> m ()
dbg1IO FilePath
"using nearest config file" FilePath
f IO ()
-> IO (Either FilePath (Conf, Maybe FilePath))
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO (Either FilePath (Conf, Maybe FilePath))
readConfFile FilePath
f
[] -> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ (Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath)
forall a b. b -> Either a b
Right ((Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath))
-> (Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> (Conf, Maybe FilePath) -> (Conf, Maybe FilePath)
forall a. FilePath -> a -> a
dbg1Msg FilePath
"no config file found" (Conf
nullconf, Maybe FilePath
forall a. Maybe a
Nothing)
getConf' :: RawOpts -> IO (Conf, Maybe FilePath)
getConf' :: RawOpts -> IO (Conf, Maybe FilePath)
getConf' RawOpts
rawopts = RawOpts -> IO (Either FilePath (Conf, Maybe FilePath))
getConf RawOpts
rawopts IO (Either FilePath (Conf, Maybe FilePath))
-> (Either FilePath (Conf, Maybe FilePath)
-> IO (Conf, Maybe FilePath))
-> IO (Conf, Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO (Conf, Maybe FilePath))
-> ((Conf, Maybe FilePath) -> IO (Conf, Maybe FilePath))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Conf, Maybe FilePath)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO (Conf, Maybe FilePath)
forall a. FilePath -> a
error' (FilePath -> IO (Conf, Maybe FilePath))
-> ShowS -> FilePath -> IO (Conf, Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> FilePath
show) (Conf, Maybe FilePath) -> IO (Conf, Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
readConfFile :: FilePath -> IO (Either String (Conf, Maybe FilePath))
readConfFile :: FilePath -> IO (Either FilePath (Conf, Maybe FilePath))
readConfFile FilePath
f = (IOError -> IO (Either FilePath (Conf, Maybe FilePath)))
-> IO (Either FilePath (Conf, Maybe FilePath))
-> IO (Either FilePath (Conf, Maybe FilePath))
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOError
e::IOError) -> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (Conf, Maybe FilePath)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Conf, Maybe FilePath))
-> FilePath -> Either FilePath (Conf, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e) (IO (Either FilePath (Conf, Maybe FilePath))
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> IO (Either FilePath (Conf, Maybe FilePath))
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
case Bool
exists of
Bool
False -> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (Conf, Maybe FilePath)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Conf, Maybe FilePath))
-> FilePath -> Either FilePath (Conf, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
f FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" does not exist"
Bool
True -> do
Either (ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
ecs <- FilePath -> IO FilePath
readFile FilePath
f IO FilePath
-> (FilePath
-> Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection])
-> IO
(Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath
-> Text
-> Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
parseConf FilePath
f (Text
-> Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection])
-> (FilePath -> Text)
-> FilePath
-> Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
case Either (ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
ecs of
Left ParseErrorBundle Text HledgerParseErrorData
err -> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (Conf, Maybe FilePath)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Conf, Maybe FilePath))
-> FilePath -> Either FilePath (Conf, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text HledgerParseErrorData -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text HledgerParseErrorData
err
Right [ConfSection]
cs -> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath)))
-> Either FilePath (Conf, Maybe FilePath)
-> IO (Either FilePath (Conf, Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ (Conf, Maybe FilePath) -> Either FilePath (Conf, Maybe FilePath)
forall a b. b -> Either a b
Right (Conf
nullconf{
confFile = f
,confFormat = 1
,confSections = cs
},
FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f
)
activeConfFile :: IO (Maybe FilePath)
activeConfFile :: IO (Maybe FilePath)
activeConfFile = [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMay ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
confFiles
activeLocalConfFile :: IO (Maybe FilePath)
activeLocalConfFile :: IO (Maybe FilePath)
activeLocalConfFile = do
[FilePath]
ufs <- IO [FilePath]
userConfFiles
Maybe FilePath
mf <- [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMay ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
confFiles
Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case Maybe FilePath
mf of
Just FilePath
f | FilePath
f FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
ufs -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f
Maybe FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing
activeUserConfFile :: IO (Maybe FilePath)
activeUserConfFile :: IO (Maybe FilePath)
activeUserConfFile = [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMay ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
userConfFiles
confFiles :: IO [FilePath]
confFiles :: IO [FilePath]
confFiles = IO [FilePath]
possibleConfFiles IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
existingFiles
userConfFiles :: IO [FilePath]
userConfFiles :: IO [FilePath]
userConfFiles = IO [FilePath]
possibleUserConfFiles IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
existingFiles
existingFiles :: [FilePath] -> IO [FilePath]
existingFiles :: [FilePath] -> IO [FilePath]
existingFiles [FilePath]
fs =
([Maybe FilePath] -> [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe FilePath] -> IO [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fs ((FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath])
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f else Maybe FilePath
forall a. Maybe a
Nothing
possibleConfFiles :: IO [FilePath]
possibleConfFiles :: IO [FilePath]
possibleConfFiles = do
[FilePath]
ds <- IO [FilePath]
possibleConfDirs
FilePath
home <- IO FilePath
getHomeDirectory
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [FilePath]
forall a. Show a => FilePath -> a -> a
dbg8 FilePath
"possible config file paths" ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
(ShowS -> [FilePath] -> [FilePath])
-> [FilePath] -> ShowS -> [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath]
ds (ShowS -> [FilePath]) -> ShowS -> [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
d -> FilePath
d FilePath -> ShowS
</> if FilePath
dFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
home then FilePath
".hledger.conf" else FilePath
"hledger.conf"
possibleUserConfFiles :: IO [FilePath]
possibleUserConfFiles :: IO [FilePath]
possibleUserConfFiles = do
FilePath
home <- IO FilePath
getHomeDirectory
FilePath
xdgc <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
"hledger"
let ds :: [FilePath]
ds = [FilePath
home,FilePath
xdgc]
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [FilePath]
forall a. Show a => FilePath -> a -> a
dbg8 FilePath
"possible user config file paths" ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
(ShowS -> [FilePath] -> [FilePath])
-> [FilePath] -> ShowS -> [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath]
ds (ShowS -> [FilePath]) -> ShowS -> [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
d -> FilePath
d FilePath -> ShowS
</> if FilePath
dFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
home then FilePath
".hledger.conf" else FilePath
"hledger.conf"
possibleConfDirs :: IO [FilePath]
possibleConfDirs :: IO [FilePath]
possibleConfDirs = do
FilePath
xdgc <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
"hledger"
FilePath
home <- IO FilePath
getHomeDirectory
FilePath
here <- IO FilePath
getCurrentDirectory
[FilePath]
dirs <- FilePath -> IO [FilePath]
getDirsUpToRoot FilePath
here
let dirs2 :: [FilePath]
dirs2 = if FilePath
home FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
dirs then [FilePath]
dirs else [FilePath]
dirs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
home]
let dirs3 :: [FilePath]
dirs3 = if FilePath
xdgc FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
dirs2 then [FilePath]
dirs2 else [FilePath]
dirs2 [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
xdgc]
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [FilePath]
forall a. Show a => FilePath -> a -> a
dbg8 FilePath
"searching config dirs" [FilePath]
dirs3
getDirsUpToRoot :: FilePath -> IO [FilePath]
getDirsUpToRoot :: FilePath -> IO [FilePath]
getDirsUpToRoot FilePath
dir = [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> [FilePath]
go [] FilePath
dir
where
go :: [FilePath] -> FilePath -> [FilePath]
go [FilePath]
seen FilePath
d = if
| FilePath
d FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
seen Bool -> Bool -> Bool
|| [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
seen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 -> []
| FilePath
dFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"/" -> [FilePath
d]
| Bool
otherwise -> FilePath
d FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> FilePath -> [FilePath]
go (FilePath
dFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
seen) (ShowS
takeDirectory FilePath
d)
parseConf :: FilePath -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
parseConf :: FilePath
-> Text
-> Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
parseConf = Parsec HledgerParseErrorData Text [ConfSection]
-> FilePath
-> Text
-> Either
(ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser Parsec HledgerParseErrorData Text [ConfSection]
confp
dp :: String -> TextParser m ()
dp :: forall (m :: * -> *). FilePath -> TextParser m ()
dp = TextParser m () -> FilePath -> TextParser m ()
forall a b. a -> b -> a
const (TextParser m () -> FilePath -> TextParser m ())
-> TextParser m () -> FilePath -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ () -> TextParser m ()
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whitespacep, commentlinesp, restoflinep :: TextParser Identity ()
whitespacep :: TextParser Identity ()
whitespacep = ParsecT HledgerParseErrorData Text Identity FilePath
-> TextParser Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text Identity FilePath
-> TextParser Identity ())
-> ParsecT HledgerParseErrorData Text Identity FilePath
-> TextParser Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT HledgerParseErrorData Text Identity Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline
= ParsecT HledgerParseErrorData Text Identity [()]
-> TextParser Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text Identity [()]
-> TextParser Identity ())
-> ParsecT HledgerParseErrorData Text Identity [()]
-> TextParser Identity ()
forall a b. (a -> b) -> a -> b
$ TextParser Identity ()
-> ParsecT HledgerParseErrorData Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (FilePath -> TextParser Identity ()
forall (m :: * -> *). FilePath -> TextParser m ()
emptyorcommentlinep2 FilePath
"#")
restoflinep :: TextParser Identity ()
restoflinep = TextParser Identity () -> TextParser Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TextParser Identity () -> TextParser Identity ())
-> TextParser Identity () -> TextParser Identity ()
forall a b. (a -> b) -> a -> b
$ TextParser Identity ()
whitespacep TextParser Identity ()
-> TextParser Identity () -> TextParser Identity ()
forall a b.
ParsecT HledgerParseErrorData Text Identity a
-> ParsecT HledgerParseErrorData Text Identity b
-> ParsecT HledgerParseErrorData Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> TextParser Identity ()
forall (m :: * -> *). FilePath -> TextParser m ()
emptyorcommentlinep2 FilePath
"#"
confp :: TextParser Identity [ConfSection]
confp :: Parsec HledgerParseErrorData Text [ConfSection]
confp = do
FilePath -> TextParser Identity ()
forall (m :: * -> *). FilePath -> TextParser m ()
dp FilePath
"confp"
TextParser Identity ()
commentlinesp
[FilePath]
genas <- ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT HledgerParseErrorData Text Identity FilePath
arglinep
let s :: ConfSection
s = FilePath -> [FilePath] -> ConfSection
ConfSection FilePath
"general" [FilePath]
genas
[ConfSection]
ss <- ParsecT HledgerParseErrorData Text Identity ConfSection
-> Parsec HledgerParseErrorData Text [ConfSection]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT HledgerParseErrorData Text Identity ConfSection
-> Parsec HledgerParseErrorData Text [ConfSection])
-> ParsecT HledgerParseErrorData Text Identity ConfSection
-> Parsec HledgerParseErrorData Text [ConfSection]
forall a b. (a -> b) -> a -> b
$ do
(FilePath
n, Maybe FilePath
ma) <- TextParser Identity (FilePath, Maybe FilePath)
sectionstartp
[FilePath]
as <- ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT HledgerParseErrorData Text Identity FilePath
arglinep
ConfSection
-> ParsecT HledgerParseErrorData Text Identity ConfSection
forall a. a -> ParsecT HledgerParseErrorData Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfSection
-> ParsecT HledgerParseErrorData Text Identity ConfSection)
-> ConfSection
-> ParsecT HledgerParseErrorData Text Identity ConfSection
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ConfSection
ConfSection FilePath
n ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath]
as (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
as) Maybe FilePath
ma)
TextParser Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
[ConfSection] -> Parsec HledgerParseErrorData Text [ConfSection]
forall a. a -> ParsecT HledgerParseErrorData Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConfSection] -> Parsec HledgerParseErrorData Text [ConfSection])
-> [ConfSection] -> Parsec HledgerParseErrorData Text [ConfSection]
forall a b. (a -> b) -> a -> b
$ ConfSection
sConfSection -> [ConfSection] -> [ConfSection]
forall a. a -> [a] -> [a]
:[ConfSection]
ss
sectionstartp :: TextParser Identity (String, Maybe String)
sectionstartp :: TextParser Identity (FilePath, Maybe FilePath)
sectionstartp = do
FilePath -> TextParser Identity ()
forall (m :: * -> *). FilePath -> TextParser m ()
dp FilePath
"sectionstartp"
Token Text
-> ParsecT HledgerParseErrorData Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'['
FilePath
n <- ShowS
-> ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall a b.
(a -> b)
-> ParsecT HledgerParseErrorData Text Identity a
-> ParsecT HledgerParseErrorData Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
strip (ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity FilePath)
-> ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath)
-> ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall a b. (a -> b) -> a -> b
$ [Token Text]
-> ParsecT HledgerParseErrorData Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf FilePath
[Token Text]
"]#\n"
Token Text
-> ParsecT HledgerParseErrorData Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']'
TextParser Identity ()
whitespacep
Maybe FilePath
ma <- (Maybe FilePath -> Maybe FilePath)
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
forall a b.
(a -> b)
-> ParsecT HledgerParseErrorData Text Identity a
-> ParsecT HledgerParseErrorData Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> Maybe FilePath -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
strip) (ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath))
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath))
-> ParsecT HledgerParseErrorData Text Identity FilePath
-> ParsecT HledgerParseErrorData Text Identity (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath)
-> ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall a b. (a -> b) -> a -> b
$ [Token Text]
-> ParsecT HledgerParseErrorData Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf FilePath
[Token Text]
"#\n"
TextParser Identity ()
restoflinep
TextParser Identity ()
commentlinesp
(FilePath, Maybe FilePath)
-> TextParser Identity (FilePath, Maybe FilePath)
forall a. a -> ParsecT HledgerParseErrorData Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
n, Maybe FilePath
ma)
arglinep :: TextParser Identity String
arglinep :: ParsecT HledgerParseErrorData Text Identity FilePath
arglinep = do
FilePath -> TextParser Identity ()
forall (m :: * -> *). FilePath -> TextParser m ()
dp FilePath
"arglinep"
ParsecT HledgerParseErrorData Text Identity Char
-> TextParser Identity ()
forall a.
ParsecT HledgerParseErrorData Text Identity a
-> TextParser Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT HledgerParseErrorData Text Identity Char
-> TextParser Identity ())
-> ParsecT HledgerParseErrorData Text Identity Char
-> TextParser Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> ParsecT HledgerParseErrorData Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'['
TextParser Identity ()
whitespacep
FilePath
a <- ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath)
-> ParsecT HledgerParseErrorData Text Identity Char
-> ParsecT HledgerParseErrorData Text Identity FilePath
forall a b. (a -> b) -> a -> b
$ [Token Text]
-> ParsecT HledgerParseErrorData Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf FilePath
[Token Text]
"#\n"
TextParser Identity ()
restoflinep TextParser Identity ()
-> TextParser Identity () -> TextParser Identity ()
forall a.
ParsecT HledgerParseErrorData Text Identity a
-> ParsecT HledgerParseErrorData Text Identity a
-> ParsecT HledgerParseErrorData Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser Identity ()
whitespacep
TextParser Identity ()
commentlinesp
FilePath -> ParsecT HledgerParseErrorData Text Identity FilePath
forall a. a -> ParsecT HledgerParseErrorData Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ParsecT HledgerParseErrorData Text Identity FilePath)
-> FilePath -> ParsecT HledgerParseErrorData Text Identity FilePath
forall a b. (a -> b) -> a -> b
$ ShowS
strip FilePath
a