module System.REPL.Config (
readConfigFile,
readConfigJSON,
readConfigShow,
NoConfigFileParseError(..),
) where
import Prelude hiding ((++), FilePath)
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Default
import Data.Functor.Monadic
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text as T
import qualified System.FilePath as Fp
import System.Directory
import System.REPL.Types
import Text.Read (readMaybe)
noParseError :: Fp.FilePath -> NoConfigFileParseError
noParseError = NoConfigFileParseError . T.pack
readConfigShow :: forall m a.
(MonadThrow m, Functor m, MonadIO m, Default a, Show a,
Read a)
=> Fp.FilePath
-> m a
readConfigShow path = readConfigFile path readEither showBS
where
showBS = encodeUtf8 . T.pack . show
readEither = maybe (Left $ noParseError path) Right . readMaybe . T.unpack . decodeUtf8
readConfigJSON :: forall m a.
(MonadThrow m, Functor m, MonadIO m, Default a, ToJSON a,
FromJSON a)
=> Fp.FilePath
-> m a
readConfigJSON path = readConfigFile path decodeEither (BL.toStrict . encode)
where
decodeEither = maybe (Left $ noParseError path) Right . decode . BL.fromStrict
readConfigFile :: forall e m a.
(MonadThrow m, Functor m, MonadIO m, Default a, Exception e)
=> Fp.FilePath
-> (B.ByteString -> Either e a)
-> (a -> B.ByteString)
-> m a
readConfigFile path parser writer = do
liftIO $ createDirectoryIfMissing True $ Fp.takeDirectory path
exists <- liftIO $ doesFileExist path
content <- if not exists then do liftIO $ B.writeFile path (writer (def :: a))
return $ Right def
else liftIO (B.readFile path) >$> parser
either throwM return content