diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,20 @@ `life-sync` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 1.1.1.0 — May 21, 2020 + +* [#101](https://github.com/kowainik/life-sync/issues/101): + Support GHC-8.10.1. +* [#98](https://github.com/kowainik/life-sync/issues/98): + Use `relude-0.7.0.0`. +* [#100](https://github.com/kowainik/life-sync/issues/100): + Use `tomland-1.3.0.0`. +* [#97](https://github.com/kowainik/life-sync/issues/97): + Use `validation-selective-0.1.0.0`. +* [#96](https://github.com/kowainik/life-sync/issues/97): + Use `colourista-0.1.0.0`. +* Use `path-0.7.0`. + ## 1.1.0.0 — Mar 25, 2020 * [#36](https://github.com/kowainik/life-sync/issues/36): diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -55,7 +55,7 @@ or ```shell -$ stack install life-sync-1.0 +$ stack install life-sync ``` ### Homebrew @@ -79,7 +79,7 @@ ```shell $ sudo add-apt-repository ppa:kowainik/life-sync $ sudo apt update -$ sudo apt intsall life-sync +$ sudo apt install life-sync ``` ### Setup diff --git a/life-sync.cabal b/life-sync.cabal --- a/life-sync.cabal +++ b/life-sync.cabal @@ -1,9 +1,9 @@ cabal-version: 2.4 name: life-sync -version: 1.1.0.0 +version: 1.1.1.0 synopsis: Synchronize personal configs across multiple machines. description: Synchronize personal configs across multiple machines. - See README for more details. + See [README](https://github.com/kowainik/life-sync#life-sync) for more details. homepage: https://github.com/kowainik/life-sync bug-reports: https://github.com/kowainik/life-sync/issues license: MPL-2.0 @@ -17,19 +17,19 @@ extra-doc-files: README.md CHANGELOG.md tested-with: GHC == 8.8.3 + GHC == 8.10.1 source-repository head type: git location: https://github.com/kowainik/life-sync.git common common-options - build-depends: base ^>= 4.13.0.0 - , relude ^>= 0.6.0.0 + build-depends: base >= 4.13.0.0 && < 4.15 + , relude ^>= 0.7.0.0 mixins: base hiding (Prelude) , relude (Relude as Prelude , Relude.Extra.Lens - , Relude.Unsafe ) ghc-options: -Wall @@ -44,6 +44,8 @@ if impl(ghc >= 8.8.1) ghc-options: -Wmissing-deriving-strategies -Werror=missing-deriving-strategies + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages default-language: Haskell2010 default-extensions: ConstraintKinds @@ -78,18 +80,17 @@ Life.Message Life.Path - build-depends: bytestring - , colourista ^>= 0.0.0.0 - , containers - , exceptions + build-depends: bytestring ^>= 0.10 + , colourista ^>= 0.1.0.0 + , containers ^>= 0.6 + , exceptions ^>= 0.10.0 , optparse-applicative ^>= 0.15 - , path - , path-io - , process + , path == 0.7.0 + , path-io ^>= 1.6.0 , shellmet ^>= 0.0.3.0 , text ^>= 1.2 - , tomland ^>= 1.2.1.0 - , validation-selective ^>= 0.0.0.0 + , tomland ^>= 1.3.0.0 + , validation-selective ^>= 0.1.0.0 executable life import: common-options @@ -114,3 +115,4 @@ , hspec-hedgehog ^>= 0.0.1.1 , path , text + , tomland diff --git a/src/Life/Configuration.hs b/src/Life/Configuration.hs --- a/src/Life/Configuration.hs +++ b/src/Life/Configuration.hs @@ -14,6 +14,11 @@ , lifeConfigMinus + -- Config + , CorpseConfiguration (..) + , corpseConfiguationCodec + , resurrect + -- -- * Parsing exceptions -- , ParseLifeException (..) @@ -25,7 +30,6 @@ -- * Parse 'LifeConfiguration' under @~/.life@ , parseHomeLife , parseRepoLife - , parseLifeConfiguration -- * Render 'LifeConfiguration' under @~/.life@ , renderLifeConfiguration @@ -33,7 +37,7 @@ ) where import Control.Monad.Catch (MonadThrow (..)) -import Path (Dir, File, Path, Rel, fromAbsFile, parseRelDir, parseRelFile, toFilePath, ()) +import Path (Dir, File, Path, Rel, fromAbsFile, parseRelDir, parseRelFile, ()) import Relude.Extra.Lens (Lens', lens, (.~), (^.)) import Toml (TomlCodec, (.=)) @@ -42,7 +46,6 @@ import qualified Data.Set as Set import qualified Data.Text as T -import qualified Text.Show as Show import qualified Toml @@ -124,8 +127,8 @@ , corpseDirectories :: [FilePath] } -corpseConfiguationT :: TomlCodec CorpseConfiguration -corpseConfiguationT = CorpseConfiguration +corpseConfiguationCodec :: TomlCodec CorpseConfiguration +corpseConfiguationCodec = CorpseConfiguration <$> Toml.arrayOf Toml._String "files" .= corpseFiles <*> Toml.arrayOf Toml._String "directories" .= corpseDirectories @@ -142,9 +145,10 @@ -- TODO: should tomland one day support this?... -- | Converts 'LifeConfiguration' into TOML file. -renderLifeConfiguration :: Bool -- ^ True to see empty entries in output - -> LifeConfiguration - -> Text +renderLifeConfiguration + :: Bool -- ^ True to see empty entries in output + -> LifeConfiguration + -> Text renderLifeConfiguration printIfEmpty LifeConfiguration{..} = mconcat $ maybeToList (render "directories" lifeConfigurationDirectories) ++ [ "\n" ] @@ -177,15 +181,11 @@ -- Life configuration parsing ---------------------------------------------------------------------------- -parseLifeConfiguration :: MonadThrow m => Text -> m LifeConfiguration -parseLifeConfiguration tomlText = case Toml.decode corpseConfiguationT tomlText of - Left err -> throwM $ LoadTomlException (toFilePath lifePath) $ Toml.prettyException err - Right cfg -> resurrect cfg - parseLife :: Path Rel File -> IO LifeConfiguration -parseLife path = relativeToHome path - >>= readFileText . fromAbsFile - >>= parseLifeConfiguration +parseLife path = + relativeToHome path + >>= Toml.decodeFile corpseConfiguationCodec . fromAbsFile + >>= resurrect -- | Reads 'LifeConfiguration' from @~\/.life@ file. parseHomeLife :: IO LifeConfiguration @@ -194,10 +194,3 @@ -- | Reads 'LifeConfiguration' from @~\/dotfiles\/.life@ file. parseRepoLife :: IO LifeConfiguration parseRepoLife = parseLife (repoName lifePath) - -data LoadTomlException = LoadTomlException FilePath Text - -instance Show.Show LoadTomlException where - show (LoadTomlException filePath msg) = "Couldnt parse file " ++ filePath ++ ": " ++ show msg - -instance Exception LoadTomlException diff --git a/src/Life/Github.hs b/src/Life/Github.hs --- a/src/Life/Github.hs +++ b/src/Life/Github.hs @@ -27,6 +27,7 @@ , getUserLogin ) where +import Colourista (errorMessage, infoMessage, warningMessage) import Control.Exception (catch, throwIO) import Path (Abs, Dir, File, Path, Rel, toFilePath, ()) import Path.IO (copyDirRecur, copyFile, getHomeDir, withCurrentDir) @@ -35,7 +36,7 @@ import Life.Configuration (LifeConfiguration (..), lifeConfigMinus, parseRepoLife) import Life.Core (Branch (..), CommitMsg (..), CopyDirection (..), Owner (..), Repo (..), master) -import Life.Message (chooseYesNo, errorMessage, infoMessage, warningMessage) +import Life.Message (chooseYesNo) import Life.Path (lifePath, relativeToHome, repoName) import qualified Data.Text as Text diff --git a/src/Life/Main/Add.hs b/src/Life/Main/Add.hs --- a/src/Life/Main/Add.hs +++ b/src/Life/Main/Add.hs @@ -12,6 +12,7 @@ ( lifeAdd ) where +import Colourista (errorMessage, infoMessage, warningMessage) import Path (Abs, Dir, File, Path, Rel, parent, toFilePath, ()) import Path.IO (copyDirRecur, copyFile, doesDirExist, doesFileExist, ensureDir, getHomeDir, makeRelative, resolveDir, resolveFile) @@ -21,7 +22,7 @@ import Life.Core (LifePath (..), master) import Life.Github (addToRepo, withSynced) import Life.Main.Init (lifeInitQuestion) -import Life.Message (abortCmd, errorMessage, infoMessage, warningMessage) +import Life.Message (abortCmd) import Life.Path (LifeExistence (..), relativeToHome, repoName, whatIsLife) import qualified Data.Set as Set diff --git a/src/Life/Main/Init.hs b/src/Life/Main/Init.hs --- a/src/Life/Main/Init.hs +++ b/src/Life/Main/Init.hs @@ -13,15 +13,16 @@ , lifeInitQuestion ) where +import Colourista (infoMessage, skipMessage, successMessage, warningMessage) import Path (mkRelFile) import Path.IO (doesDirExist, doesFileExist) + import Life.Configuration (LifeConfiguration (..), parseHomeLife, renderLifeConfiguration, singleFileConfig, writeGlobalLife) import Life.Core (CopyDirection (..), Owner (..), Repo (..), master) import Life.Github (copyLife, createRepository, insideRepo) -import Life.Message (abortCmd, chooseYesNo, infoMessage, promptNonEmpty, skipMessage, - successMessage, warningMessage) +import Life.Message (abortCmd, chooseYesNo, promptNonEmpty) import Life.Path (LifeExistence (..), createDirInHome, lifePath, relativeToHome, repoName, whatIsLife) diff --git a/src/Life/Main/Pull.hs b/src/Life/Main/Pull.hs --- a/src/Life/Main/Pull.hs +++ b/src/Life/Main/Pull.hs @@ -10,13 +10,14 @@ ( lifePull ) where +import Colourista (warningMessage) import Path (Dir, File, Path, Rel) import Life.Configuration (LifeConfiguration (..), defaultLifeConfig) import Life.Core (Owner) import Life.Github (cloneRepo, pullUpdateFromRepo, updateFromRepo) import Life.Main.Init (lifeInitQuestion) -import Life.Message (abortCmd, choose, warningMessage) +import Life.Message (abortCmd, choose) import Life.Path (LifeExistence (..), whatIsLife) @@ -30,8 +31,9 @@ initOrPull :: IO () initOrPull = do warningMessage ".life file and dotfiles repo not found" - action <- choose "Do you want to (F)etch existing repo, (I)nit from scratch or (A)bort operation?" - ["f", "i", "a"] + action <- choose + "Do you want to (F)etch existing repo, (I)nit from scratch or (A)bort operation?" + ("f" :| ["i", "a"]) case action of "f" -> clone >> update "i" -> lifeInitQuestion "pull" pass diff --git a/src/Life/Main/Remove.hs b/src/Life/Main/Remove.hs --- a/src/Life/Main/Remove.hs +++ b/src/Life/Main/Remove.hs @@ -12,6 +12,7 @@ ( lifeRemove ) where +import Colourista (warningMessage) import Path (Abs, Path, Rel) import Path.IO (getHomeDir, makeRelative, removeDirRecur, removeFile, resolveDir, resolveFile) import Relude.Extra.Lens (Lens', (%~)) @@ -19,7 +20,7 @@ import Life.Configuration (LifeConfiguration, directoriesL, filesL, parseHomeLife, writeGlobalLife) import Life.Core (LifePath (..), master) import Life.Github (removeFromRepo, withSynced) -import Life.Message (abortCmd, warningMessage) +import Life.Message (abortCmd) import Life.Path (LifeExistence (..), whatIsLife) import qualified Data.Set as Set diff --git a/src/Life/Message.hs b/src/Life/Message.hs --- a/src/Life/Message.hs +++ b/src/Life/Message.hs @@ -13,11 +13,6 @@ module Life.Message ( prompt , promptNonEmpty - , errorMessage - , warningMessage - , successMessage - , infoMessage - , skipMessage , abortCmd -- * Questions @@ -25,12 +20,10 @@ , chooseYesNo ) where -import Colourista (blue, bold, formatWith) +import Colourista (blue, bold, errorMessage, formatWith, warningMessage) import System.IO (hFlush) -import qualified Colourista import qualified Data.Text as T -import qualified Relude.Unsafe as Unsafe ---------------------------------------------------------------------------- @@ -60,17 +53,6 @@ boldDefault :: Text -> Text boldDefault message = formatWith [bold] $ " [" <> message <> "]" -errorMessage, warningMessage, successMessage, infoMessage, skipMessage :: Text -> IO () -errorMessage = Colourista.errorMessage . indent -warningMessage = Colourista.warningMessage . indent -successMessage = Colourista.successMessage . indent -infoMessage = Colourista.infoMessage . indent -skipMessage = Colourista.skipMessage . indent - --- | Add 2 spaces in front. -indent :: Text -> Text -indent = (" " <>) - -- | Print message and abort current process. abortCmd :: Text -> Text -> IO () abortCmd cmd msg = do @@ -89,17 +71,19 @@ putStrFlush $ question <> boldDefault def putTextLn $ "/" <> restSlash -choose :: Text -> [Text] -> IO Text +choose :: Text -> NonEmpty Text -> IO Text choose question choices = do - printQuestion question choices + printQuestion question $ toList choices answer <- prompt - if | T.null answer -> pure (Unsafe.head choices) + if | T.null answer -> pure (head choices) | T.toLower answer `elem` choices -> pure answer | otherwise -> do errorMessage "This wasn't a valid choice." choose question choices -data Answer = Y | N +data Answer + = Y + | N yesOrNo :: Text -> Maybe Answer yesOrNo (T.toLower -> answer ) diff --git a/test/Test/Configuration.hs b/test/Test/Configuration.hs --- a/test/Test/Configuration.hs +++ b/test/Test/Configuration.hs @@ -13,14 +13,15 @@ import Test.Hspec (Spec, describe, it, shouldBe) import Test.Hspec.Hedgehog (hedgehog) -import Life.Configuration (LifeConfiguration (..), directoriesL, filesL, parseLifeConfiguration, - renderLifeConfiguration) +import Life.Configuration (LifeConfiguration (..), corpseConfiguationCodec, directoriesL, filesL, + renderLifeConfiguration, resurrect) import Life.Core (master) import qualified Data.Set as Set import qualified Data.Text as T import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range +import qualified Toml configurationSpec :: Spec @@ -70,7 +71,9 @@ parseRenderSpec :: PropertyT IO () parseRenderSpec = hedgehog $ do cfg <- forAll genLifeConfiguration - tripping cfg (renderLifeConfiguration True) (parseLifeConfiguration @Maybe) + tripping cfg + (renderLifeConfiguration True) + (\t -> rightToMaybe (Toml.decode corpseConfiguationCodec t) >>= resurrect) genLifeConfiguration :: Gen LifeConfiguration genLifeConfiguration = do