life-sync 1.0.1 → 1.1.0.0

raw patch · 25 files changed

+1264/−656 lines, 25 filesdep +basedep +colouristadep +hspecdep −ansi-terminaldep −base-nopreludedep −fmtdep ~filepathdep ~hedgehogdep ~optparse-applicativesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: base, colourista, hspec, hspec-hedgehog, shellmet, validation-selective

Dependencies removed: ansi-terminal, base-noprelude, fmt, microlens-platform, tasty, tasty-hedgehog

Dependency ranges changed: filepath, hedgehog, optparse-applicative, relude, text, tomland

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−5
• LICENSE +369/−17
• README.md +32/−1
• Setup.hs +0/−2
• app/Main.hs +3/−21
• app/Options.hs +0/−119
• life-sync.cabal +80/−66
• src/Life/Cli.hs +125/−0
• src/Life/Configuration.hs +90/−69
• src/Life/Core.hs +63/−0
• src/Life/Github.hs +96/−63
• src/Life/Main.hs +34/−0
• src/Life/Main/Add.hs +32/−24
• src/Life/Main/Init.hs +19/−12
• src/Life/Main/Pull.hs +19/−8
• src/Life/Main/Push.hs +24/−16
• src/Life/Main/Remove.hs +23/−15
• src/Life/Message.hs +40/−59
• src/Life/Path.hs +74/−0
• src/Life/Shell.hs +0/−87
• src/Life/Validation.hs +0/−27
• src/Prelude.hs +0/−7
• test/Spec.hs +9/−1
• test/Test/Configuration.hs +94/−0
• test/Test/Roundtrip.hs +0/−37

@@ -1,14 +1,47 @@-Change log-==========+# Changelog -life-sync uses [PVP Versioning][1].+`life-sync` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. -# 1.0.1+## 1.1.0.0 — Mar 25, 2020 +* [#36](https://github.com/kowainik/life-sync/issues/36):+  Get GitHub username from `.gitconfig` if applicable.+  (by [@SanchayanMaity](https://github.com/SanchayanMaity))+* [#48](https://github.com/kowainik/life-sync/issues/48):+  Fix minor bug with broken `life add -d`.+  (by [@nixorn](https://github.com/nixorn))+* [#65](https://github.com/kowainik/life-sync/issues/65):+    + Move to GHC-8.8.3.+    + Bump up `relude` to `0.6.0.0`.+    + Bump up `tomland` to `1.2.1.0`.+    + Bump up `optparse-applicative` to `0.15`.+  (by [@chshersh](https://github.com/chshersh))+* [#68](https://github.com/kowainik/life-sync/issues/68):+  Move to `validation-selective`.+  (by [@chshersh](https://github.com/chshersh))+* [#75](https://github.com/kowainik/life-sync/issues/75):+  Move to `colourista`.+  (by [@chshersh](https://github.com/chshersh))+* [#70](https://github.com/kowainik/life-sync/issues/70):+  Move to `shellmet`.+  (by [@vrom911](https://github.com/vrom911))+* [#77](https://github.com/kowainik/life-sync/issues/77):+  Remove `fmt` dependency.+  (by [@chshersh](https://github.com/chshersh))+* [#79](https://github.com/kowainik/life-sync/issues/79):+  Remove `microlens-platform` dependency.+  (by [@vrom911](https://github.com/vrom911))+* [#59](https://github.com/kowainik/life-sync/issues/59):+  Bump to relude-0.4.0.+  Bump to GHC-8.4.4.+  (by [@nixorn](https://github.com/nixorn))++## 1.0.1+ * Switch to `relude`. -# 1.0+## 1.0  * Initially created. 

@@ -1,21 +1,373 @@-MIT License+Mozilla Public License Version 2.0+================================== -Copyright (c) 2017 Dmitry Kovanikov+1. Definitions+-------------- -Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:+1.1. "Contributor"+    means each individual or legal entity that creates, contributes to+    the creation of, or owns Covered Software. -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+1.2. "Contributor Version"+    means the combination of the Contributions of others (if any) used+    by a Contributor and that particular Contributor's Contribution. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.+1.3. "Contribution"+    means Covered Software of a particular Contributor.++1.4. "Covered Software"+    means Source Code Form to which the initial Contributor has attached+    the notice in Exhibit A, the Executable Form of such Source Code+    Form, and Modifications of such Source Code Form, in each case+    including portions thereof.++1.5. "Incompatible With Secondary Licenses"+    means++    (a) that the initial Contributor has attached the notice described+        in Exhibit B to the Covered Software; or++    (b) that the Covered Software was made available under the terms of+        version 1.1 or earlier of the License, but not also under the+        terms of a Secondary License.++1.6. "Executable Form"+    means any form of the work other than Source Code Form.++1.7. "Larger Work"+    means a work that combines Covered Software with other material, in+    a separate file or files, that is not Covered Software.++1.8. "License"+    means this document.++1.9. "Licensable"+    means having the right to grant, to the maximum extent possible,+    whether at the time of the initial grant or subsequently, any and+    all of the rights conveyed by this License.++1.10. "Modifications"+    means any of the following:++    (a) any file in Source Code Form that results from an addition to,+        deletion from, or modification of the contents of Covered+        Software; or++    (b) any new file in Source Code Form that contains any Covered+        Software.++1.11. "Patent Claims" of a Contributor+    means any patent claim(s), including without limitation, method,+    process, and apparatus claims, in any patent Licensable by such+    Contributor that would be infringed, but for the grant of the+    License, by the making, using, selling, offering for sale, having+    made, import, or transfer of either its Contributions or its+    Contributor Version.++1.12. "Secondary License"+    means either the GNU General Public License, Version 2.0, the GNU+    Lesser General Public License, Version 2.1, the GNU Affero General+    Public License, Version 3.0, or any later versions of those+    licenses.++1.13. "Source Code Form"+    means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+    means an individual or a legal entity exercising rights under this+    License. For legal entities, "You" includes any entity that+    controls, is controlled by, or is under common control with You. For+    purposes of this definition, "control" means (a) the power, direct+    or indirect, to cause the direction or management of such entity,+    whether by contract or otherwise, or (b) ownership of more than+    fifty percent (50%) of the outstanding shares or beneficial+    ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+    Licensable by such Contributor to use, reproduce, make available,+    modify, display, perform, distribute, and otherwise exploit its+    Contributions, either on an unmodified basis, with Modifications, or+    as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+    for sale, have made, import, and otherwise transfer either its+    Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+    or++(b) for infringements caused by: (i) Your and any other third party's+    modifications of Covered Software, or (ii) the combination of its+    Contributions with other software (except as part of its Contributor+    Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+    its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+    Form, as described in Section 3.1, and You must inform recipients of+    the Executable Form how they can obtain a copy of such Source Code+    Form by reasonable means in a timely manner, at a charge no more+    than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+    License, or sublicense it under different terms, provided that the+    license for the Executable Form does not attempt to limit or alter+    the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+*                                                                      *+*  6. Disclaimer of Warranty                                           *+*  -------------------------                                           *+*                                                                      *+*  Covered Software is provided under this License on an "as is"       *+*  basis, without warranty of any kind, either expressed, implied, or  *+*  statutory, including, without limitation, warranties that the       *+*  Covered Software is free of defects, merchantable, fit for a        *+*  particular purpose or non-infringing. The entire risk as to the     *+*  quality and performance of the Covered Software is with You.        *+*  Should any Covered Software prove defective in any respect, You     *+*  (not any Contributor) assume the cost of any necessary servicing,   *+*  repair, or correction. This disclaimer of warranty constitutes an   *+*  essential part of this License. No use of any Covered Software is   *+*  authorized under this License except under this disclaimer.         *+*                                                                      *+************************************************************************++************************************************************************+*                                                                      *+*  7. Limitation of Liability                                          *+*  --------------------------                                          *+*                                                                      *+*  Under no circumstances and under no legal theory, whether tort      *+*  (including negligence), contract, or otherwise, shall any           *+*  Contributor, or anyone who distributes Covered Software as          *+*  permitted above, be liable to You for any direct, indirect,         *+*  special, incidental, or consequential damages of any character      *+*  including, without limitation, damages for lost profits, loss of    *+*  goodwill, work stoppage, computer failure or malfunction, or any    *+*  and all other commercial damages or losses, even if such party      *+*  shall have been informed of the possibility of such damages. This   *+*  limitation of liability shall not apply to liability for death or   *+*  personal injury resulting from such party's negligence to the       *+*  extent applicable law prohibits such limitation. Some               *+*  jurisdictions do not allow the exclusion or limitation of           *+*  incidental or consequential damages, so this exclusion and          *+*  limitation may not apply to You.                                    *+*                                                                      *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++  This Source Code Form is subject to the terms of the Mozilla Public+  License, v. 2.0. If a copy of the MPL was not distributed with this+  file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++  This Source Code Form is "Incompatible With Secondary Licenses", as+  defined by the Mozilla Public License, v. 2.0.

@@ -6,7 +6,7 @@ [![Stackage LTS](http://stackage.org/package/life-sync/badge/lts)](http://stackage.org/lts/package/life-sync) [![Stackage Nightly](http://stackage.org/package/life-sync/badge/nightly)](http://stackage.org/nightly/package/life-sync) -`life-sync` is a CLI tool that makes it easier to synchronize a repository of +`life-sync` is a CLI tool that makes it easier to synchronize a repository of personal config files across multiple machines.  ## Motivation@@ -41,6 +41,11 @@  ## Installation +There are several ways to install `life` on your machine.+Here are detailed instructions on different approaches.++### From Hackage/Stackage+ Install with one simple command:  ```shell@@ -52,6 +57,32 @@ ```shell $ stack install life-sync-1.0 ```++### Homebrew++If you are on MacOS, you can get `life-sync` using+[Homebrew](https://brew.sh/) Kowainik's Tap.++You need to run the following commands for that:++```shell+$ brew tap kowainik/tap+$ brew install life-sync+```++### Ubuntu++If you are on Ubuntu, you can get `life-sync` from Kowainik's PPA.++You need to run the following commands for that:++```shell+$ sudo add-apt-repository ppa:kowainik/life-sync+$ sudo apt update+$ sudo apt intsall life-sync+```++### Setup  You can turn on bash auto-completion by running the following command: 

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,24 +1,6 @@-module Main where--import Path (parseRelDir, parseRelFile)--import Life.Main.Add (lifeAdd)-import Life.Main.Init (lifeInit)-import Life.Main.Pull (lifePull)-import Life.Main.Push (lifePush)-import Life.Main.Remove (lifeRemove)--import Options (LifeCommand (..), PathOptions (..), PullOptions (..), parseCommand)+module Main (main) where -import qualified Data.Set as Set+import Life.Main (lifeMain)  main :: IO ()-main = parseCommand >>= \case-    Init   owner           -> lifeInit   owner-    Add    PathOptions{..} -> lifeAdd    pathOptionsPath-    Remove PathOptions{..} -> lifeRemove pathOptionsPath-    Push                   -> lifePush-    Pull   PullOptions{..} -> do-        withoutFiles <- Set.fromList <$> mapM parseRelFile pullOptionsNoFiles-        withoutDirs  <- Set.fromList <$> mapM parseRelDir  pullOptionsNoDirs-        lifePull pullOptionsOwner withoutFiles withoutDirs+main = lifeMain

@@ -1,119 +0,0 @@-{-# LANGUAGE ApplicativeDo #-}---- | Command line options for Importify--module Options-       ( LifeCommand (..)-       , PathOptions (..)-       , PullOptions (..)--       , parseCommand-       ) where--import Options.Applicative (Parser, ParserInfo, command, execParser, fullDesc, help, helper, info,-                            long, metavar, progDesc, short, strArgument, strOption, subparser)--import Life.Configuration (LifePath (..))-import Life.Github (Owner (..))---- | Commands to execute-data LifeCommand-    = Init   Owner-    | Add    PathOptions-    | Remove PathOptions-    | Push-    | Pull   PullOptions-    deriving (Show)-------------------------------------------------------------------------------- Boilerplate-------------------------------------------------------------------------------commandParser :: Parser LifeCommand-commandParser = subparser $-    command "init"-            (info (helper <*> fmap Init ownerParser)-                  (fullDesc <> progDesc "Initialize GitHub repository named 'dotfiles' if you don't have one."))- <> command "add"-            (info (helper <*> fmap Add pathOptionsParser)-                  (fullDesc <> progDesc "Add file or directory to the life configuration."))- <> command "remove"-            (info (helper <*> fmap Remove pathOptionsParser)-                  (fullDesc <> progDesc "Remove file or directory from the life configuration."))- <> command "push"-            (info (helper <*> pure Push)-                  (fullDesc <> progDesc "Updates GitHub repository from local state and push the latest version."))- <> command "pull"-            (info (helper <*> fmap Pull pullOptionsParser)-                  (fullDesc <> progDesc "Updates local state of '.life' and 'dotfiles' from GitHub repository."))---optionsInfo :: ParserInfo LifeCommand-optionsInfo = info-    (helper  <*> commandParser)-    (fullDesc <> progDesc "life-sync synchronize your personal configs")--parseCommand :: IO LifeCommand-parseCommand = execParser optionsInfo--ownerParser :: Parser Owner-ownerParser = fmap Owner-     $ strArgument-     $ metavar "OWNER"-    <> help "Your github user name"--------------------------------------------------------------------------------- life pull-------------------------------------------------------------------------------data PullOptions = PullOptions-    { pullOptionsOwner   :: Owner-    , pullOptionsNoFiles :: [FilePath]-    , pullOptionsNoDirs  :: [FilePath]-    } deriving (Show)--pullOptionsParser :: Parser PullOptions-pullOptionsParser = do-    pullOptionsOwner <- ownerParser--    -- TODO: reuse LifePath parser here?...-    pullOptionsNoFiles <- many $ strOption-                        $ metavar "FILE_PATH"-                       <> long "no-file"-                       <> short 'f'-                       <> help "Excluding these specific files from copying"--    pullOptionsNoDirs <- many $ strOption-                       $ metavar "FILE_PATH"-                      <> long "no-dir"-                      <> short 'd'-                      <> help "Excluding these specific directories from copying"--    pure PullOptions{..}--------------------------------------------------------------------------------- life add and remove-------------------------------------------------------------------------------data PathOptions = PathOptions-     { pathOptionsPath :: LifePath-     } deriving (Show)--pathOptionsParser :: Parser PathOptions-pathOptionsParser = do-    pathOptionsPath <- fileParser <|> dirParser-    pure PathOptions{..}-  where-    fileParser :: Parser LifePath-    fileParser = File <$> strOption-                        ( metavar "FILE_PATH"-                       <> long "file"-                       <> short 'f'-                        )--    dirParser :: Parser LifePath-    dirParser = Dir <$> strOption-                        ( metavar "DIRECTORY_PATH"-                       <> long "dir"-                       <> short 'd'-                        )

@@ -1,102 +1,116 @@+cabal-version:       2.4 name:                life-sync-version:             1.0.1-description:         Synchronize personal configs across multiple machines+version:             1.1.0.0+synopsis:            Synchronize personal configs across multiple machines.+description:         Synchronize personal configs across multiple machines.+                     See README for more details. homepage:            https://github.com/kowainik/life-sync bug-reports:         https://github.com/kowainik/life-sync/issues-license:             MIT+license:             MPL-2.0 license-file:        LICENSE-author:              Kowainik-maintainer:          xrom.xkov@gmail.com-copyright:           2018 Kowainik-category:            Configuration+author:              Dmitrii Kovanikov, Veronika Romashkina+maintainer:          Kowainik <xrom.xkov@gmail.com>+copyright:           2018-2020 Kowainik+category:            Configuration, CLI, CLI Tool, Development stability:           experimental build-type:          Simple-cabal-version:       2.0-tested-with:         GHC == 8.2.2-                   , GHC == 8.4.3 extra-doc-files:     README.md-                   , CHANGELOG.md+                     CHANGELOG.md+tested-with:         GHC == 8.8.3  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++  mixins:              base hiding (Prelude)+                     , relude (Relude as Prelude+                              , Relude.Extra.Lens+                              , Relude.Unsafe+                              )++  ghc-options:         -Wall+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -fhide-source-paths+                       -Wmissing-export-lists+                       -Wpartial-fields+  if impl(ghc >= 8.8.1)+    ghc-options:       -Wmissing-deriving-strategies+                       -Werror=missing-deriving-strategies++  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                       DeriveGeneric+                       DerivingStrategies+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       KindSignatures+                       LambdaCase+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeApplications+                       ViewPatterns+ library+  import:              common-options   hs-source-dirs:      src -  exposed-modules:     Prelude+  exposed-modules:     Life.Cli                        Life.Configuration+                       Life.Core                        Life.Github+                       Life.Main+                         Life.Main.Add+                         Life.Main.Init+                         Life.Main.Pull+                         Life.Main.Push+                         Life.Main.Remove                        Life.Message-                       Life.Shell-                       Life.Main.Add-                       Life.Main.Init-                       Life.Main.Pull-                       Life.Main.Push-                       Life.Main.Remove-                       Life.Validation+                       Life.Path -  build-depends:       base-noprelude >= 4.9 && < 5-                     , ansi-terminal-                     , bytestring+  build-depends:       bytestring+                     , colourista ^>= 0.0.0.0                      , containers                      , exceptions-                     , fmt-                     , microlens-platform+                     , optparse-applicative ^>= 0.15                      , path                      , path-io                      , process-                     , relude >= 0.1.0-                     , text >= 1.2-                     , tomland ^>= 0.3--  ghc-options:         -Wall-  default-language:    Haskell2010--  default-extensions:  GeneralizedNewtypeDeriving-                       LambdaCase-                       OverloadedStrings-                       RecordWildCards-                       ScopedTypeVariables-                       TypeApplications+                     , shellmet ^>= 0.0.3.0+                     , text ^>= 1.2+                     , tomland ^>= 1.2.1.0+                     , validation-selective ^>= 0.0.0.0  executable life+  import:              common-options   hs-source-dirs:      app   main-is:             Main.hs-  other-modules:       Options-  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N--  build-depends:       base-noprelude-                     , containers-                     , life-sync-                     , optparse-applicative-                     , path--  default-language:    Haskell2010--  default-extensions:  LambdaCase-                       OverloadedStrings-                       RecordWildCards+  build-depends:       life-sync+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N  test-suite life-sync-test+  import:              common-options   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs-  other-modules:       Test.Roundtrip+  other-modules:       Test.Configuration+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -  build-tool-depends:  tasty-discover:tasty-discover-  build-depends:       base-noprelude, life-sync+  build-depends:       life-sync                      , containers-                     , filepath-                     , hedgehog+                     , filepath ^>= 1.4+                     , hedgehog ^>= 1.0+                     , hspec ^>= 2.7.1+                     , hspec-hedgehog ^>= 0.0.1.1                      , path-                     , tasty-                     , tasty-hedgehog--  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N-  default-language:    Haskell2010--  default-extensions:  LambdaCase-                       OverloadedStrings-                       RecordWildCards-                       TypeApplications+                     , text

@@ -0,0 +1,125 @@+{-# LANGUAGE ApplicativeDo #-}++{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Command line options for @life@.+-}++module Life.Cli+    ( LifeCommand (..)+    , PathOptions (..)+    , PullOptions (..)++    , parseCommand+    ) where++import Options.Applicative (Parser, ParserInfo, command, execParser, fullDesc, help, helper, info,+                            long, metavar, progDesc, short, strOption, subparser)++import Life.Core (LifePath (..), Owner (..))+++-- | Commands to execute+data LifeCommand+    = Init   (Maybe Owner)+    | Add    PathOptions+    | Remove PathOptions+    | Push+    | Pull   PullOptions+    deriving stock (Show)++---------------------------------------------------------------------------+-- Boilerplate+----------------------------------------------------------------------------++commandParser :: Parser LifeCommand+commandParser = subparser $+    command "init"+            (info (helper <*> fmap Init (optional ownerParser))+                  (fullDesc <> progDesc "Initialize GitHub repository named 'dotfiles' if you don't have one."))+ <> command "add"+            (info (helper <*> fmap Add pathOptionsParser)+                  (fullDesc <> progDesc "Add file or directory to the life configuration."))+ <> command "remove"+            (info (helper <*> fmap Remove pathOptionsParser)+                  (fullDesc <> progDesc "Remove file or directory from the life configuration."))+ <> command "push"+            (info (helper <*> pure Push)+                  (fullDesc <> progDesc "Updates GitHub repository from local state and push the latest version."))+ <> command "pull"+            (info (helper <*> fmap Pull pullOptionsParser)+                  (fullDesc <> progDesc "Updates local state of '.life' and 'dotfiles' from GitHub repository."))+++optionsInfo :: ParserInfo LifeCommand+optionsInfo = info+    (helper  <*> commandParser)+    (fullDesc <> progDesc "life-sync synchronize your personal configs")++parseCommand :: IO LifeCommand+parseCommand = execParser optionsInfo++ownerParser :: Parser Owner+ownerParser = fmap Owner+     $ strOption+     $ metavar "OWNER"+    <> help "Your github user name"++----------------------------------------------------------------------------+-- life pull+----------------------------------------------------------------------------++data PullOptions = PullOptions+    { pullOptionsOwner   :: Maybe Owner+    , pullOptionsNoFiles :: [FilePath]+    , pullOptionsNoDirs  :: [FilePath]+    } deriving stock (Show)++pullOptionsParser :: Parser PullOptions+pullOptionsParser = do+    pullOptionsOwner   <- optional ownerParser++    -- TODO: reuse LifePath parser here?...+    pullOptionsNoFiles <- many $ strOption+                        $ metavar "FILE_PATH"+                       <> long "no-file"+                       <> short 'f'+                       <> help "Excluding these specific files from copying"++    pullOptionsNoDirs <- many $ strOption+                       $ metavar "FILE_PATH"+                      <> long "no-dir"+                      <> short 'd'+                      <> help "Excluding these specific directories from copying"++    pure PullOptions{..}++----------------------------------------------------------------------------+-- life add and remove+----------------------------------------------------------------------------++newtype PathOptions = PathOptions+     { pathOptionsPath :: LifePath+     } deriving stock (Show)++pathOptionsParser :: Parser PathOptions+pathOptionsParser = do+    pathOptionsPath <- fileParser <|> dirParser+    pure PathOptions{..}+  where+    fileParser :: Parser LifePath+    fileParser = File <$> strOption+                        ( metavar "FILE_PATH"+                       <> long "file"+                       <> short 'f'+                        )++    dirParser :: Parser LifePath+    dirParser = Dir <$> strOption+                        ( metavar "DIRECTORY_PATH"+                       <> long "dir"+                       <> short 'd'+                        )

@@ -1,96 +1,119 @@-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TemplateHaskell        #-}+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> --- | Contains configuration data type.+Contains configuration data type — 'LifeConfiguration'.+-}  module Life.Configuration-       ( LifePath (..)--       , LifeConfiguration  (..)-       , singleDirConfig-       , singleFileConfig+    ( LifeConfiguration (..)+    , singleDirConfig+    , singleFileConfig+    , defaultLifeConfig -       , lifeConfigMinus+    , lifeConfigMinus ---         -- * Parsing exceptions---       , ParseLifeException (..)+--      -- * Parsing exceptions+--    , ParseLifeException (..) -         -- * Lenses for 'LifeConfiguration'-       , files-       , directories+      -- * Lenses for 'LifeConfiguration'+    , filesL+    , directoriesL+    , branchL -         -- * Parse 'LifeConfiguration' under @~/.life@-       , parseHomeLife-       , parseRepoLife-       , parseLifeConfiguration+      -- * Parse 'LifeConfiguration' under @~/.life@+    , parseHomeLife+    , parseRepoLife+    , parseLifeConfiguration -         -- * Render 'LifeConfiguration' under @~/.life@-       , renderLifeConfiguration-       , writeGlobalLife-       ) where+      -- * Render 'LifeConfiguration' under @~/.life@+    , renderLifeConfiguration+    , writeGlobalLife+    ) where  import Control.Monad.Catch (MonadThrow (..))-import Fmt (indentF, unlinesF, (+|), (|+))-import Lens.Micro.Platform (makeFields, (.~), (^.)) import Path (Dir, File, Path, Rel, fromAbsFile, parseRelDir, parseRelFile, toFilePath, (</>))-import Toml (AnyValue (..), BiToml, Prism (..), (.=))+import Relude.Extra.Lens (Lens', lens, (.~), (^.))+import Toml (TomlCodec, (.=)) -import Life.Shell (lifePath, relativeToHome, repoName)+import Life.Core (Branch (..), master)+import Life.Path (lifePath, relativeToHome, repoName)  import qualified Data.Set as Set import qualified Data.Text as T import qualified Text.Show as Show import qualified Toml --- | Data type to represent either file or directory.-data LifePath = File FilePath | Dir FilePath-    deriving (Show) -------------------------------------------------------------------------------- Life Configuration data type with lenses------------------------------------------------------------------------------+-- | The configurations data type. data LifeConfiguration = LifeConfiguration-     { lifeConfigurationFiles       :: Set (Path Rel File)-     , lifeConfigurationDirectories :: Set (Path Rel Dir)-     } deriving (Show, Eq)+     { lifeConfigurationFiles       :: !(Set (Path Rel File))+     , lifeConfigurationDirectories :: !(Set (Path Rel Dir))+     , lifeConfigurationBranch      :: !(Last Branch)+     } deriving stock (Show, Eq) -makeFields ''LifeConfiguration+-- | Lens for 'lifeConfigurationFiles'.+filesL :: Lens' LifeConfiguration (Set (Path Rel File))+filesL = lens+    lifeConfigurationFiles+    (\config newFiles -> config {lifeConfigurationFiles = newFiles}) +-- | Lens for 'lifeConfigurationDirectories'.+directoriesL :: Lens' LifeConfiguration (Set (Path Rel Dir))+directoriesL = lens+    lifeConfigurationDirectories+    (\config newDirs -> config {lifeConfigurationDirectories = newDirs})++-- | Lens for 'lifeConfigurationBranch'.+branchL :: Lens' LifeConfiguration (Last Branch)+branchL = lens+    lifeConfigurationBranch+    (\config newBr -> config {lifeConfigurationBranch = newBr})+ ---------------------------------------------------------------------------- -- Algebraic instances and utilities ----------------------------------------------------------------------------  instance Semigroup LifeConfiguration where     life1 <> life2 = LifeConfiguration-        { lifeConfigurationFiles       = life1^.files <> life2^.files-        , lifeConfigurationDirectories = life1^.directories <> life2^.directories+        { lifeConfigurationFiles       = (life1 ^. filesL) <> (life2 ^. filesL)+        , lifeConfigurationDirectories = (life1 ^. directoriesL) <> (life2 ^. directoriesL)+        , lifeConfigurationBranch      = (life1 ^. branchL) <> (life2 ^. branchL)         }  instance Monoid LifeConfiguration where-    mempty  = LifeConfiguration mempty mempty+    mempty  = LifeConfiguration mempty mempty mempty     mappend = (<>) +-- | The defaulting 'LifeConfiguration', with the default @master@ branch.+defaultLifeConfig :: LifeConfiguration+defaultLifeConfig = LifeConfiguration+    { lifeConfigurationFiles       = mempty+    , lifeConfigurationDirectories = mempty+    , lifeConfigurationBranch      = Last $ Just master+    }++-- | Creates a 'LifeConfiguration' with the given file. singleFileConfig :: Path Rel File -> LifeConfiguration-singleFileConfig file = mempty & files .~ one file+singleFileConfig file = mempty & filesL .~ one file +-- | Creates a 'LifeConfiguration' with the given folder. singleDirConfig :: Path Rel Dir -> LifeConfiguration-singleDirConfig dir = mempty & directories .~ one dir+singleDirConfig dir = mempty & directoriesL .~ one dir  ---------------------------------------------------------------------------- -- LifeConfiguration difference ---------------------------------------------------------------------------- -lifeConfigMinus :: LifeConfiguration -- ^ repo .life config-                -> LifeConfiguration -- ^ global config-                -> LifeConfiguration -- ^ configs that are not in global+lifeConfigMinus+    :: LifeConfiguration -- ^ Repository @.life@ configuration+    -> LifeConfiguration -- ^ Global configuration+    -> LifeConfiguration -- ^ Configuration that is not in global lifeConfigMinus dotfiles global = LifeConfiguration-    (Set.difference (dotfiles ^. files) (global ^. files))-    (Set.difference (dotfiles ^. directories) (global ^. directories))+    (Set.difference (dotfiles ^. filesL) (global ^. filesL))+    (Set.difference (dotfiles ^. directoriesL) (global ^. directoriesL))+    (Last $ Just master)  ---------------------------------------------------------------------------- -- Toml parser for life configuration@@ -101,16 +124,10 @@     , corpseDirectories :: [FilePath]     } -corpseConfiguationT :: BiToml CorpseConfiguration+corpseConfiguationT :: TomlCodec CorpseConfiguration corpseConfiguationT = CorpseConfiguration-    <$> Toml.arrayOf _String "files"       .= corpseFiles-    <*> Toml.arrayOf _String "directories" .= corpseDirectories-  where-    _String :: Prism AnyValue String-    _String = Prism-        { preview = \(AnyValue t) -> Toml.matchText t >>= pure . toString-        , review = AnyValue . Toml.Text . toText-        }+    <$> Toml.arrayOf Toml._String "files"       .= corpseFiles+    <*> Toml.arrayOf Toml._String "directories" .= corpseDirectories  resurrect :: MonadThrow m => CorpseConfiguration -> m LifeConfiguration resurrect CorpseConfiguration{..} = do@@ -120,6 +137,7 @@     pure $ LifeConfiguration         { lifeConfigurationFiles = Set.fromList filePaths         , lifeConfigurationDirectories = Set.fromList dirPaths+        , lifeConfigurationBranch = Last (Just master)         }  -- TODO: should tomland one day support this?...@@ -135,22 +153,25 @@     render :: Text -> Set (Path b t) -> Maybe Text     render key paths = do         let prefix = key <> " = "-        let array  = renderStringArray (T.length prefix) (map show $ toList paths)-+        let array  = renderStringArray $ map show $ toList paths         if not printIfEmpty && null paths         then Nothing         else Just $ prefix <> array -    renderStringArray :: Int -> [String] -> Text-    renderStringArray _ []     = "[]"-    renderStringArray n (x:xs) = "[ " +| x |+ "\n"-                              +| indentF n (unlinesF (map (", " ++) xs ++ ["]"]))-                              |+ ""+    renderStringArray :: [Text] -> Text+    renderStringArray = \case+        [] -> "[]"+        [x] -> "[" <> x <> "]"+        l -> mconcat+            [ "\n    [ "+            , T.intercalate "\n    , " l+            , "\n    ]"+            ]  writeGlobalLife :: LifeConfiguration -> IO () writeGlobalLife config = do     lifeFilePath <- relativeToHome lifePath-    writeFile (fromAbsFile lifeFilePath) (renderLifeConfiguration True config)+    writeFileText (fromAbsFile lifeFilePath) (renderLifeConfiguration True config)  ---------------------------------------------------------------------------- -- Life configuration parsing@@ -163,7 +184,7 @@  parseLife :: Path Rel File -> IO LifeConfiguration parseLife path = relativeToHome path-             >>= readFile . fromAbsFile+             >>= readFileText . fromAbsFile              >>= parseLifeConfiguration  -- | Reads 'LifeConfiguration' from @~\/.life@ file.

@@ -0,0 +1,63 @@+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Contains main data types used in the project.+-}++module Life.Core+    (+      -- * Git and Github core+      Branch (..)+    , Owner  (..)+    , Repo   (..)+    , CommitMsg (..)+    , master++      -- * File system logic+    , CopyDirection (..)+    , LifePath (..)+    ) where++----------------------------------------------------------------------------+-- Git and Github core+----------------------------------------------------------------------------++-- | Github repository owner.+newtype Owner = Owner+    { unOwner :: Text+    } deriving stock (Show)++-- | Git repository.+newtype Repo  = Repo+    { unRepo :: Text+    } deriving stock (Show)++-- | Git branch.+newtype Branch = Branch+    { unBranch :: Text+    } deriving stock (Show)+      deriving newtype (Eq)++-- | Git commit message.+newtype CommitMsg = CommitMsg+    { unCommitMsg :: Text+    } deriving stock (Show)++-- | Git "master" branch constant.+master :: Branch+master = Branch "master"++----------------------------------------------------------------------------+-- File system logic+----------------------------------------------------------------------------++data CopyDirection+    = FromHomeToRepo+    | FromRepoToHome++data LifePath+    = File FilePath+    | Dir FilePath+    deriving stock (Show)

@@ -1,67 +1,88 @@--- | Utilities to work with GitHub repositories using "hub".+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> -module Life.Github-       ( Owner (..)-       , Repo  (..)+Utilities to work with GitHub repositories using @hub@.+-} -         -- * Repository utils-       , checkRemoteSync-       , cloneRepo-       , insideRepo-       , withSynced+module Life.Github+    (+      -- * Repository utils+      checkRemoteSync+    , cloneRepo+    , createNewBranch+    , doesBranchExist+    , insideRepo+    , withSynced -         -- * Repository manipulation commands-       , CopyDirection (..)-       , copyLife-       , addToRepo-       , createRepository-       , pullUpdateFromRepo-       , removeFromRepo-       , updateDotfilesRepo-       , updateFromRepo-       ) where+      -- * Repository manipulation commands+    , copyLife+    , addToRepo+    , createRepository+    , pullUpdateFromRepo+    , removeFromRepo+    , updateDotfilesRepo+    , updateFromRepo+    , getUserLogin+    ) where  import Control.Exception (catch, throwIO) import Path (Abs, Dir, File, Path, Rel, toFilePath, (</>)) import Path.IO (copyDirRecur, copyFile, getHomeDir, withCurrentDir)+import Shellmet (($|)) import System.IO.Error (IOError, isDoesNotExistError)  import Life.Configuration (LifeConfiguration (..), lifeConfigMinus, parseRepoLife)+import Life.Core (Branch (..), CommitMsg (..), CopyDirection (..), Owner (..), Repo (..), master) import Life.Message (chooseYesNo, errorMessage, infoMessage, warningMessage)-import Life.Shell (lifePath, relativeToHome, repoName, ($|))+import Life.Path (lifePath, relativeToHome, repoName) -newtype Owner = Owner { getOwner :: Text } deriving (Show)-newtype Repo  = Repo  { getRepo  :: Text } deriving (Show)+import qualified Data.Text as Text + ---------------------------------------------------------------------------- -- VSC commands ---------------------------------------------------------------------------- -askToPushka :: Text -> IO ()+askToPushka :: CommitMsg -> IO () askToPushka commitMsg = do     "git" ["add", "."]     infoMessage "The following changes are going to be pushed:"     "git" ["diff", "--name-status", "HEAD"]     continue <- chooseYesNo "Would you like to proceed?"     if continue-    then pushka commitMsg+    then pushka master commitMsg     else errorMessage "Abort pushing" >> exitFailure  -- | Make a commit and push it.-pushka :: Text -> IO ()-pushka commitMsg = do+pushka :: Branch -> CommitMsg -> IO ()+pushka (Branch branch) (CommitMsg commitMsg) = do     "git" ["add", "."]     "git" ["commit", "-m", commitMsg]-    "git" ["push", "-u", "origin", "master"]+    "git" ["push", "-u", "origin", branch]  -- | Creates repository on GitHub inside given folder.-createRepository :: Owner -> Repo -> IO ()-createRepository (Owner owner) (Repo repo) = do+createRepository :: Maybe Owner -> Repo -> IO ()+createRepository mo (Repo repo) = do+    owner <- getOwnerLogin mo     let description = ":computer: Configuration files"     "git" ["init"]     "hub" ["create", "-d", description, owner <> "/" <> repo]-    pushka "Create the project"+    pushka master $ CommitMsg "Create the project" +-- | Get user login from the local global git config.+getUserLogin :: IO Text+getUserLogin = do+    login <- "git" $| ["config", "user.login"]+    if login == ""+        then errorMessage "user.login is not specified" >> exitFailure+        else pure $ toText login++-- | Consider owner from global git config if Owner is not given+getOwnerLogin :: Maybe Owner -> IO Text+getOwnerLogin = maybe getUserLogin (pure . unOwner)+ ---------------------------------------------------------------------------- -- dotfiles workflow ----------------------------------------------------------------------------@@ -73,29 +94,41 @@     withCurrentDir repoPath action  -- | Commits all changes inside 'repoName' and pushes to remote.-pushRepo :: Text -> IO ()+pushRepo :: CommitMsg -> IO () pushRepo = insideRepo . askToPushka  -- | Clones @dotfiles@ repository assuming it doesn't exist.-cloneRepo :: Owner -> IO ()-cloneRepo (Owner owner) = do+cloneRepo :: Maybe Owner -> IO ()+cloneRepo mo = do+    owner <- getOwnerLogin mo     homeDir <- getHomeDir     withCurrentDir homeDir $ do         infoMessage "Using SSH to clone repo..."         "git" ["clone", "git@github.com:" <> owner <> "/dotfiles.git"] +-- | Create new branch with given branch name+createNewBranch :: Branch -> IO ()+createNewBranch (Branch branch) =+    "git" ["checkout", "-b", branch]+ -- | Returns true if local @dotfiles@ repository is synchronized with remote repo.-checkRemoteSync :: IO Bool-checkRemoteSync = do-    "git" ["fetch", "origin", "master"]-    localHash  <- "git" $| ["rev-parse", "master"]-    remoteHash <- "git" $| ["rev-parse", "origin/master"]+checkRemoteSync :: Branch -> IO Bool+checkRemoteSync (Branch branch) = do+    "git" ["fetch", "origin", branch]+    localHash  <- "git" $| ["rev-parse", branch]+    remoteHash <- "git" $| ["rev-parse", "origin/" <> branch]     pure $ localHash == remoteHash -withSynced :: IO a -> IO a-withSynced action = insideRepo $ do-    infoMessage "Checking if repo is synchnorized..."-    isSynced <- checkRemoteSync+-- | Check if a branch exists in remote repo+doesBranchExist :: Branch -> IO Bool+doesBranchExist (Branch branch) = do+    r <- "git" $| ["ls-remote", "--heads", "origin", branch]+    pure $ not (Text.null r)++withSynced :: Branch -> IO a -> IO a+withSynced branch@(Branch branchname) action = insideRepo $ do+    infoMessage "Checking if repo is synchronized..."+    isSynced <- checkRemoteSync branch     if isSynced then do         infoMessage "Repo is up-to-date"         action@@ -103,7 +136,7 @@         warningMessage "Local version of repository is out of date"         shouldSync <- chooseYesNo "Do you want to sync repo with remote?"         if shouldSync then do-            "git" ["rebase", "origin/master"]+            "git" ["rebase", "origin/" <> branchname]             action         else do             errorMessage "Aborting current command because repository is not synchronized with remote"@@ -113,8 +146,6 @@ -- File manipulation ---------------------------------------------------------------------------- -data CopyDirection = FromHomeToRepo | FromRepoToHome- pullUpdateFromRepo :: LifeConfiguration -> IO () pullUpdateFromRepo life = do     insideRepo $ "git" ["pull", "-r"]@@ -129,7 +160,7 @@      copyLife FromRepoToHome lifeToLive -updateDotfilesRepo :: Text -> LifeConfiguration -> IO ()+updateDotfilesRepo :: CommitMsg -> LifeConfiguration -> IO () updateDotfilesRepo commitMsg life = do     copyLife FromHomeToRepo life     pushRepo commitMsg@@ -147,13 +178,14 @@ copyDirs :: CopyDirection -> [Path Rel Dir] -> IO () copyDirs = copyPathList copyDirRecur -copyPathList :: (Path Abs t -> Path Abs t -> IO ())-             -- ^ Copying action-             -> CopyDirection-             -- ^ Describes in which direction files should be copied-             -> [Path Rel t]-             -- ^ List of paths to copy-             -> IO ()+copyPathList+    :: (Path Abs t -> Path Abs t -> IO ())+    -- ^ Copying action+    -> CopyDirection+    -- ^ Describes in which direction files should be copied+    -> [Path Rel t]+    -- ^ List of paths to copy+    -> IO () copyPathList copyAction direction pathList = do     homeDir    <- getHomeDir     let repoDir = homeDir </> repoName@@ -165,6 +197,13 @@             FromHomeToRepo -> copyAction homePath repoPath             FromRepoToHome -> copyAction repoPath homePath +-- | Update .life file+updateLifeFile :: IO ()+updateLifeFile = do+    lifeFile <- relativeToHome lifePath+    repoLifeFile <- relativeToHome (repoName </> lifePath)+    copyFile lifeFile repoLifeFile+ -- | Adds file or directory to the repository and commits addToRepo :: (Path Abs t -> Path Abs t -> IO ()) -> Path Rel t -> IO () addToRepo copyFun path = do@@ -173,12 +212,9 @@     destinationPath <- relativeToHome (repoName </> path)     copyFun sourcePath destinationPath -    -- update .life file-    lifeFile <- relativeToHome lifePath-    repoLifeFile <- relativeToHome (repoName </> lifePath)-    copyFile lifeFile repoLifeFile+    updateLifeFile -    let commitMsg = "Add: " <> toText (toFilePath path)+    let commitMsg = CommitMsg $ "Add: " <> toText (toFilePath path)     pushRepo commitMsg  -- | Removes file or directory from the repository and commits@@ -187,12 +223,9 @@     absPath <- relativeToHome (repoName </> path)     catch (removeFun absPath) handleNotExist -    -- update .life file-    lifeFile <- relativeToHome lifePath-    repoLifeFile <- relativeToHome (repoName </> lifePath)-    copyFile lifeFile repoLifeFile+    updateLifeFile -    let commitMsg = "Remove: " <> pathTextName+    let commitMsg = CommitMsg $ "Remove: " <> pathTextName     pushRepo commitMsg   where     pathTextName :: Text

@@ -0,0 +1,34 @@+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Main entry point for the @life@ executable.+-}++module Life.Main+    ( lifeMain+    ) where++import Path (parseRelDir, parseRelFile)++import Life.Cli (LifeCommand (..), PathOptions (..), PullOptions (..), parseCommand)+import Life.Main.Add (lifeAdd)+import Life.Main.Init (lifeInit)+import Life.Main.Pull (lifePull)+import Life.Main.Push (lifePush)+import Life.Main.Remove (lifeRemove)++import qualified Data.Set as Set+++lifeMain :: IO ()+lifeMain = parseCommand >>= \case+    Init   owner           -> lifeInit   owner+    Add    PathOptions{..} -> lifeAdd    pathOptionsPath+    Remove PathOptions{..} -> lifeRemove pathOptionsPath+    Push                   -> lifePush+    Pull   PullOptions{..} -> do+        withoutFiles <- Set.fromList <$> mapM parseRelFile pullOptionsNoFiles+        withoutDirs  <- Set.fromList <$> mapM parseRelDir  pullOptionsNoDirs+        lifePull pullOptionsOwner withoutFiles withoutDirs

@@ -1,31 +1,37 @@ {-# LANGUAGE Rank2Types #-} --- | Functions to add file/directory to your life.+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> +Functions to add file/directory to your life.+-}+ module Life.Main.Add-       ( lifeAdd-       ) where+    ( lifeAdd+    ) where -import Lens.Micro.Platform (Lens', (%~)) import Path (Abs, Dir, File, Path, Rel, parent, toFilePath, (</>)) import Path.IO (copyDirRecur, copyFile, doesDirExist, doesFileExist, ensureDir, getHomeDir,                 makeRelative, resolveDir, resolveFile)+import Relude.Extra.Lens (Lens', (%~)) -import Life.Configuration (LifeConfiguration, LifePath (..), directories, files, parseHomeLife,-                           writeGlobalLife)+import Life.Configuration (LifeConfiguration, directoriesL, filesL, parseHomeLife, writeGlobalLife)+import Life.Core (LifePath (..), master) import Life.Github (addToRepo, withSynced) import Life.Main.Init (lifeInitQuestion) import Life.Message (abortCmd, errorMessage, infoMessage, warningMessage)-import Life.Shell (LifeExistence (..), relativeToHome, repoName, whatIsLife)+import Life.Path (LifeExistence (..), relativeToHome, repoName, whatIsLife) -import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as Set + -- | Add path to existing life-configuration file. lifeAdd :: LifePath -> IO () lifeAdd lPath = whatIsLife >>= \case     -- actual life add process-    Both _ _ -> withSynced addingProcess+    Both _ _ -> withSynced master addingProcess      -- if one of them is missing -- abort     OnlyRepo _ -> abortCmd "add" ".life file doesn't exist"@@ -42,28 +48,30 @@                 filePath <- resolveFile homeDirPath path                 whenM (doesFileExist filePath) $ do                     relativeFile <- makeRelative homeDirPath filePath-                    resolveConfiguration files checkEqualFiles copyFileWithDir relativeFile+                    resolveConfiguration filesL checkEqualFiles copyFileWithDir relativeFile              (Dir path)  -> do                 dirPath <- resolveDir homeDirPath path                 whenM (doesDirExist dirPath) $ do                     relativeDir <- makeRelative homeDirPath dirPath-                    resolveConfiguration directories checkEqualDirs copyDirRecur relativeDir+                    resolveConfiguration directoriesL checkEqualDirs copyDirRecur relativeDir              -- We didn't find the file         errorMessage "The file/directory doesn't exist" >> exitFailure -resolveConfiguration :: Lens' LifeConfiguration (Set (Path Rel t))-                     -> (Path Rel t -> IO Bool)-                     -> (Path Abs t -> Path Abs t -> IO ())-                     -> Path Rel t-                     -> IO ()+resolveConfiguration+    :: Lens' LifeConfiguration (Set (Path Rel t))+    -> (Path Rel t -> IO Bool)+    -> (Path Abs t -> Path Abs t -> IO ())+    -> Path Rel t+    -> IO () resolveConfiguration confLens checkContent copyFun path = do     configuration <- parseHomeLife     let newConfiguration = configuration & confLens %~ Set.insert path      isSameAsInRepo <- checkContent path-    if isSameAsInRepo then do+    if isSameAsInRepo+    then do         let pathText = toText $ toFilePath path         infoMessage $ "Path " <> pathText <> " is already latest version in repository"     else do@@ -78,19 +86,19 @@     repoFilePath <- relativeToHome (repoName </> path)      isRepoFile <- doesFileExist repoFilePath-    if isRepoFile then do-        originContent <- LBS.readFile $ toFilePath homeFilePath-        repoContent <- LBS.readFile $ toFilePath repoFilePath+    if isRepoFile+    then do+        originContent <- readFileLBS $ toFilePath homeFilePath+        repoContent <- readFileLBS $ toFilePath repoFilePath          pure $ originContent == repoContent-    else-        pure False+    else pure False  checkEqualDirs :: Path Rel Dir -> IO Bool checkEqualDirs _ = do     warningMessage "TODO: check directories to be equal"-    pure True+    pure False --- | Just like 'copyFile' but also creates directory for second file.+-- | Just like 'copyFile' but also creates directory for the second file. copyFileWithDir :: Path Abs File -> Path Abs File -> IO () copyFileWithDir from to = ensureDir (parent to) >> copyFile from to

@@ -1,26 +1,33 @@ {-# LANGUAGE TemplateHaskell #-} --- | Contains function to create repository.+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> +Contains a function to create the main repository — @dotfiles@.+-}+ module Life.Main.Init-       ( lifeInit-       , lifeInitQuestion-       ) where+    ( lifeInit+    , lifeInitQuestion+    ) where  import Path (mkRelFile) import Path.IO (doesDirExist, doesFileExist)  import Life.Configuration (LifeConfiguration (..), parseHomeLife, renderLifeConfiguration,                            singleFileConfig, writeGlobalLife)-import Life.Github (CopyDirection (..), Owner (..), Repo (Repo), copyLife, createRepository,-                    insideRepo)+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.Shell (LifeExistence (..), createDirInHome, lifePath, relativeToHome, repoName,-                   whatIsLife)+import Life.Path (LifeExistence (..), createDirInHome, lifePath, relativeToHome, repoName,+                  whatIsLife)  import qualified Data.Set as Set + predefinedLifeConfig :: LifeConfiguration predefinedLifeConfig = mempty     { lifeConfigurationFiles = Set.fromList@@ -35,7 +42,7 @@           ]     } -lifeInit :: Owner -> IO ()+lifeInit :: Maybe Owner -> IO () lifeInit owner = whatIsLife >>= \case     NoLife -> createLifeFile >>= createDotfilesDir     OnlyLife _ -> askCreateLife >>= createDotfilesDir@@ -84,8 +91,8 @@ scanConfig LifeConfiguration{..} = do     (existingFiles, nonExistingFiles) <- partitionM (relativeToHome >=> doesFileExist) lifeConfigurationFiles     (existingDirs, nonExistingDirs) <- partitionM (relativeToHome >=> doesDirExist) lifeConfigurationDirectories-    pure ( LifeConfiguration (Set.fromList existingFiles) (Set.fromList existingDirs)-         , LifeConfiguration (Set.fromList nonExistingFiles) (Set.fromList nonExistingDirs)+    pure ( LifeConfiguration (Set.fromList existingFiles) (Set.fromList existingDirs) (Last $ Just master)+         , LifeConfiguration (Set.fromList nonExistingFiles) (Set.fromList nonExistingDirs) (Last $ Just master)          )  partitionM :: forall f m a . (Monad m, Foldable f) => (a -> m Bool) -> f a -> m ([a], [a])@@ -109,6 +116,6 @@         infoMessage "Initialization process starts.."         skipMessage "Insert your GitHub username:"         owner <- promptNonEmpty-        lifeInit $ Owner owner+        lifeInit $ Just $ Owner owner         process     else abortCmd cmd "'~/.life' file is not initialized"

@@ -1,18 +1,26 @@--- | Command to update local state from remote state.+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> +Command to update the local state from the remote state.+-}+ module Life.Main.Pull-       ( lifePull-       ) where+    ( lifePull+    ) where  import Path (Dir, File, Path, Rel) -import Life.Configuration (LifeConfiguration (..))-import Life.Github (Owner, cloneRepo, pullUpdateFromRepo, updateFromRepo)+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.Shell (LifeExistence (..), whatIsLife)+import Life.Path (LifeExistence (..), whatIsLife) -lifePull :: Owner -> Set (Path Rel File) -> Set (Path Rel Dir) -> IO ()++lifePull :: Maybe Owner -> Set (Path Rel File) -> Set (Path Rel Dir) -> IO () lifePull owner withoutFiles withoutDirs = whatIsLife >>= \case     OnlyRepo _ -> warningMessage ".life file not found" >> pullUpdate     OnlyLife _ -> warningMessage "dotfiles not found" >> clone >> update@@ -31,7 +39,10 @@             _   -> error "Impossible choice"      life :: LifeConfiguration-    life = LifeConfiguration withoutFiles withoutDirs+    life = defaultLifeConfig+        { lifeConfigurationDirectories = withoutDirs+        , lifeConfigurationFiles = withoutFiles+        }      clone, update, pullUpdate :: IO ()     clone = cloneRepo owner

@@ -1,40 +1,47 @@-{-# LANGUAGE TupleSections #-}+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> --- | Functions to update remote repository+Functions to update the remote repository.+-}  module Life.Main.Push-       ( lifePush-       ) where+    ( lifePush+    ) where -import Lens.Micro.Platform ((^.)) import Path (Abs, Path, Rel, toFilePath, (</>)) import Path.IO (doesDirExist, doesFileExist, removeDirRecur, removeFile)+import Relude.Extra.Lens ((^.))+import Validation (Validation (..)) -import Life.Configuration (LifeConfiguration (..), directories, files, lifeConfigMinus,+import Life.Configuration (LifeConfiguration (..), directoriesL, filesL, lifeConfigMinus,                            parseHomeLife, parseRepoLife)+import Life.Core (CommitMsg (..), master) import Life.Github (updateDotfilesRepo, withSynced) import Life.Main.Init (lifeInitQuestion) import Life.Message (abortCmd)-import Life.Shell (LifeExistence (..), relativeToHome, repoName, whatIsLife)-import Life.Validation (Validation (..))+import Life.Path (LifeExistence (..), relativeToHome, repoName, whatIsLife)  import qualified Data.Set as Set import qualified Data.Text as Text + lifePush :: IO () lifePush = whatIsLife >>= \case     OnlyRepo _ -> abortCmd "push" ".life file doesn't exist"     OnlyLife _ -> abortCmd "push" "dotfiles file doesn't exist"     NoLife     -> lifeInitQuestion "push" pushProcess-    Both _ _   -> withSynced pushProcess+    Both _ _   -> withSynced master pushProcess   where     pushProcess :: IO ()     pushProcess = do         -- check that all from .life exist         globalConf <- parseHomeLife         checkLife globalConf >>= \case-            Failure msgs -> abortCmd "push" $ "Following files/directories are missing:\n"-                                           <> Text.intercalate "\n" msgs+            Failure msgs -> abortCmd "push" $+                "Following files/directories are missing:\n"+                <> Text.intercalate "\n" msgs             Success _ -> do                 -- first, find the difference between repo .life and global .life                 repoConf <- parseRepoLife@@ -44,17 +51,18 @@                  -- copy from local files to repo including .life                 -- commmit & push-                updateDotfilesRepo "Push updates" globalConf+                updateDotfilesRepo (CommitMsg "Push updates") globalConf       -- | checks if all the files/dirs from global .life exist.     checkLife :: LifeConfiguration -> IO (Validation [Text] LifeConfiguration)     checkLife lf = do-        eFiles <- traverse (withExist doesFileExist) $ Set.toList (lf ^. files)-        eDirs  <- traverse (withExist doesDirExist) $ Set.toList (lf ^. directories)+        eFiles <- traverse (withExist doesFileExist) $ Set.toList (lf ^. filesL)+        eDirs  <- traverse (withExist doesDirExist) $ Set.toList (lf ^. directoriesL)         pure $ LifeConfiguration             <$> checkPaths eFiles             <*> checkPaths eDirs+            <*> Success (Last $ Just master)       where         withExist :: (Path Abs f -> IO Bool) -> Path Rel f -> IO (Path Rel f, Bool)         withExist doesExist path = (path,) <$> (relativeToHome path >>= doesExist)@@ -68,7 +76,7 @@     -- | removes all redundant files from repo folder.     removeAll :: LifeConfiguration -> IO ()     removeAll conf = do-        for_ (conf ^. files) $ \f ->+        for_ (conf ^. filesL) $ \f ->             relativeToHome (repoName </> f) >>= removeFile-        for_ (conf ^. directories) $ \d ->+        for_ (conf ^. directoriesL) $ \d ->             relativeToHome (repoName </> d) >>= removeDirRecur

@@ -1,23 +1,30 @@ {-# LANGUAGE Rank2Types #-} --- | Functions to remove from your life.+{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> +Functions to remove from your @life@ repository.+-}+ module Life.Main.Remove-       ( lifeRemove-       ) where+    ( lifeRemove+    ) where -import Lens.Micro.Platform (Lens', (%~)) import Path (Abs, Path, Rel) import Path.IO (getHomeDir, makeRelative, removeDirRecur, removeFile, resolveDir, resolveFile)+import Relude.Extra.Lens (Lens', (%~)) -import Life.Configuration (LifeConfiguration, LifePath (..), directories, files, parseHomeLife,-                           writeGlobalLife)+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.Shell (LifeExistence (..), whatIsLife)+import Life.Path (LifeExistence (..), whatIsLife)  import qualified Data.Set as Set + -- | Remove path from existing life-configuration file. lifeRemove :: LifePath -> IO () lifeRemove lPath = whatIsLife >>= \case@@ -26,26 +33,27 @@     OnlyLife _ -> abortCmd "remove" "dotfiles/ directory doesn't exist"     OnlyRepo _ -> abortCmd "remove" ".life file doesn't exist"     -- actual life remove process-    Both _ _ -> withSynced $ do+    Both _ _ -> withSynced master $ do         homeDirPath  <- getHomeDir         case lPath of             (File path) -> do                 filePath <- resolveFile homeDirPath path >>= makeRelative homeDirPath-                resolveConfiguration files removeFile filePath+                resolveConfiguration filesL removeFile filePath             (Dir path)  -> do                 dirPath <- resolveDir homeDirPath path >>= makeRelative homeDirPath-                resolveConfiguration directories removeDirRecur dirPath+                resolveConfiguration directoriesL removeDirRecur dirPath -resolveConfiguration :: Lens' LifeConfiguration (Set (Path Rel t))-                     -> (Path Abs t -> IO ()) -- ^ function to remove object-                     -> Path Rel t-                     -> IO ()+resolveConfiguration+    :: Lens' LifeConfiguration (Set (Path Rel t))+    -> (Path Abs t -> IO ()) -- ^ function to remove object+    -> Path Rel t+    -> IO () resolveConfiguration confLens removeFun path = do     configuration <- parseHomeLife      let newConfiguration = configuration & confLens %~ Set.delete path     if configuration == newConfiguration-    then warningMessage "File or directory is not in tracked" >> exitFailure+    then warningMessage "File or directory is not tracked" >> exitFailure     else do         writeGlobalLife newConfiguration         removeFromRepo removeFun path

@@ -1,30 +1,38 @@ {-# LANGUAGE MultiWayIf   #-} {-# LANGUAGE ViewPatterns #-} +{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Contains functions for colorful printing, prompt and other terminal related+messages.+-}+ module Life.Message-       ( beautyPrint-       , boldText-       , prompt-       , promptNonEmpty-       , errorMessage-       , warningMessage-       , successMessage-       , infoMessage-       , skipMessage-       , abortCmd+    ( prompt+    , promptNonEmpty+    , errorMessage+    , warningMessage+    , successMessage+    , infoMessage+    , skipMessage+    , abortCmd -         -- * Questions-       , choose-       , chooseYesNo-       ) where+      -- * Questions+    , choose+    , chooseYesNo+    ) where -import System.Console.ANSI (Color (..), ColorIntensity (Vivid), ConsoleIntensity (BoldIntensity),-                            ConsoleLayer (Foreground), SGR (..), setSGR)+import Colourista (blue, bold, formatWith) import System.IO (hFlush) +import qualified Colourista import qualified Data.Text as T import qualified Relude.Unsafe as Unsafe + ---------------------------------------------------------------------------- -- Ansi-terminal ----------------------------------------------------------------------------@@ -35,31 +43,11 @@     putText msg     hFlush stdout -setColor :: Color -> IO ()-setColor color = setSGR [SetColor Foreground Vivid color]---- | Starts bold printing.-bold :: IO ()-bold = setSGR [SetConsoleIntensity BoldIntensity]---- | Resets all previous settings.-reset :: IO ()-reset = do-    setSGR [Reset]-    hFlush stdout---- | Takes list of formatting options, prints text using this format options.-beautyPrint :: [IO ()] -> Text -> IO ()-beautyPrint formats msg = do-    sequence_ formats-    putText msg-    reset-+{- | Read 'Text' from standard input after arrow prompt.+-} prompt :: IO Text prompt = do-    setColor Blue-    putStrFlush "  ⟳   "-    reset+    putStrFlush $ formatWith [blue] "  ⟳   "     getLine  promptNonEmpty :: IO Text@@ -69,26 +57,20 @@         then warningMessage "The answer shouldn't be empty" >> promptNonEmpty         else pure res --boldText :: Text -> IO ()-boldText message = bold >> putStrFlush message >> reset--boldDefault :: Text -> IO ()-boldDefault message = boldText (" [" <> message <> "]")--colorMessage :: Color -> Text -> IO ()-colorMessage color message = do-    setColor color-    putTextLn $ "  " <> message-    reset+boldDefault :: Text -> Text+boldDefault message = formatWith [bold] $ " [" <> message <> "]"  errorMessage, warningMessage, successMessage, infoMessage, skipMessage :: Text -> IO ()-errorMessage   = colorMessage Red-warningMessage = colorMessage Yellow-successMessage = colorMessage Green-infoMessage    = colorMessage Blue-skipMessage    = colorMessage Cyan+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@@ -101,12 +83,11 @@ ----------------------------------------------------------------------------  printQuestion :: Text -> [Text] -> IO ()+printQuestion question [] = putTextLn question printQuestion question (def:rest) = do     let restSlash = T.intercalate "/" rest-    putStrFlush question-    boldDefault def+    putStrFlush $ question <> boldDefault def     putTextLn $ "/" <> restSlash-printQuestion question [] = putTextLn question  choose :: Text -> [Text] -> IO Text choose question choices = do

@@ -0,0 +1,74 @@+{-# LANGUAGE TemplateHaskell #-}++{- |+Copyright:  (c) 2017-2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++This module contains utility functions to work with shell.+-}++module Life.Path+    ( -- * Constants+      lifePath+    , repoName++      -- * Functions+    , LifeExistence (..)+    , createDirInHome+    , relativeToHome+    , whatIsLife+    ) where++import Path (Abs, Dir, File, Path, Rel, mkRelDir, mkRelFile, (</>))+import Path.IO (createDirIfMissing, doesDirExist, doesFileExist, getHomeDir)+++----------------------------------------------------------------------------+-- Global constants+----------------------------------------------------------------------------++-- | Name for life configuration file.+lifePath :: Path Rel File+lifePath = $(mkRelFile ".life")++-- TODO: consistent naming with @lifePath@ ?+-- | Default repository name for life configuration files.+repoName :: Path Rel Dir+repoName = $(mkRelDir "dotfiles/")++----------------------------------------------------------------------------+-- Shell interface+----------------------------------------------------------------------------++-- | Creates directory with name "folder" under "~/folder".+createDirInHome :: Path Rel Dir -> IO (Path Abs Dir)+createDirInHome dirName = do+    newDir <- relativeToHome dirName+    newDir <$ createDirIfMissing False newDir++-- | Creates path relative to home directory+relativeToHome :: MonadIO m => Path Rel t -> m (Path Abs t)+relativeToHome path = do+    homeDir <- getHomeDir+    pure $ homeDir </> path++data LifeExistence+    = NoLife+    | OnlyLife (Path Abs File)+    | OnlyRepo (Path Abs Dir)+    | Both (Path Abs File) (Path Abs Dir)++whatIsLife :: IO LifeExistence+whatIsLife = do+    lifeFile <- relativeToHome lifePath+    repoDir  <- relativeToHome repoName++    isFile <- doesFileExist lifeFile+    isDir  <- doesDirExist  repoDir++    pure $ case (isFile, isDir) of+        (False, False) -> NoLife+        (True, False)  -> OnlyLife lifeFile+        (False, True)  -> OnlyRepo repoDir+        (True, True)   -> Both lifeFile repoDir

@@ -1,87 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell   #-}-{-# LANGUAGE TypeFamilies      #-}---- | This module contains utility functions to work with shell.---- TODO: rename this module to Life.Path ?--module Life.Shell-       ( -- * Constants-         lifePath-       , repoName--         -- * Functions-       , LifeExistence (..)-       , createDirInHome-       , relativeToHome-       , whatIsLife-       , ($|)-       ) where--import Path (Abs, Dir, File, Path, Rel, mkRelDir, mkRelFile, (</>))-import Path.IO (createDirIfMissing, doesDirExist, doesFileExist, getHomeDir)-import System.Process (callCommand, readProcess, showCommandForUser)--------------------------------------------------------------------------------- Global constants--------------------------------------------------------------------------------- | Name for life configuration file.-lifePath :: Path Rel File-lifePath = $(mkRelFile ".life")---- TODO: consistent naming with @lifePath@ ?--- | Default repository name for life configuration files.-repoName :: Path Rel Dir-repoName = $(mkRelDir "dotfiles/")--------------------------------------------------------------------------------- Shell interface--------------------------------------------------------------------------------- This is needed to be able to call commands by writing strings.-instance (a ~ Text, b ~ ()) => IsString ([a] -> IO b) where-    fromString cmd args = do-        let cmdStr = showCommandForUser cmd (map toString args)-        putStrLn $ "⚙  " ++ cmdStr-        callCommand cmdStr---- | Run shell command with given options and return stdout of executed command.-infix 5 $|-($|) :: FilePath -> [Text] -> IO String-cmd $| args = readProcess cmd (map toString args) ""---- | Creates directory with name "folder" under "~/folder".-createDirInHome :: Path Rel Dir -> IO (Path Abs Dir)-createDirInHome dirName = do-    newDir <- relativeToHome dirName-    newDir <$ createDirIfMissing False newDir---- | Creates path relative to home directory-relativeToHome :: MonadIO m => Path Rel t -> m (Path Abs t)-relativeToHome path = do-    homeDir <- getHomeDir-    pure $ homeDir </> path--data LifeExistence-    = NoLife-    | OnlyLife (Path Abs File)-    | OnlyRepo (Path Abs Dir)-    | Both (Path Abs File) (Path Abs Dir)--whatIsLife :: IO LifeExistence-whatIsLife = do-    lifeFile <- relativeToHome lifePath-    repoDir  <- relativeToHome repoName--    isFile <- doesFileExist lifeFile-    isDir  <- doesDirExist  repoDir--    pure $ case (isFile, isDir) of-        (False, False) -> NoLife-        (True, False)  -> OnlyLife lifeFile-        (False, True)  -> OnlyRepo repoDir-        (True, True)   -> Both lifeFile repoDir

@@ -1,27 +0,0 @@-module Life.Validation-       ( Validation (..)-       ) where---- | 'Validation' is 'Either' with a Left that is a 'Monoid'-data Validation e a-  = Failure e-  | Success a-  deriving (Eq, Ord, Show)--instance Functor (Validation e) where-   fmap _ (Failure e) = Failure e-   fmap f (Success a) = Success (f a)--instance Semigroup e => Semigroup (Validation e a) where-  Failure e1 <> Failure e2 = Failure (e1 <> e2)-  Failure _  <> Success a2 = Success a2-  Success a1 <> Failure _  = Success a1-  Success a1 <> Success _  = Success a1--instance Semigroup e => Applicative (Validation e) where-  pure = Success--  Failure e1 <*> Failure e2 = Failure (e1 <> e2)-  Failure e1 <*> Success _  = Failure e1-  Success _  <*> Failure e2 = Failure e2-  Success f  <*> Success a  = Success (f a)

@@ -1,7 +0,0 @@--- | Uses @relude@ as default prelude.--module Prelude-       ( module Relude-       ) where--import Relude

@@ -1,1 +1,9 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+module Main (main) where++import Test.Hspec (hspec)++import Test.Configuration (configurationSpec)++main :: IO ()+main = hspec+    configurationSpec

@@ -0,0 +1,94 @@+{-# LANGUAGE QuasiQuotes #-}++module Test.Configuration+    ( configurationSpec+    ) where++import Data.Foldable (foldr1)+import Hedgehog (Gen, PropertyT, forAll, tripping)+import Path (reldir, relfile)+import Path.Internal (Path (Path))+import Relude.Extra.Lens ((.~))+import System.FilePath (pathSeparator, (</>))+import Test.Hspec (Spec, describe, it, shouldBe)+import Test.Hspec.Hedgehog (hedgehog)++import Life.Configuration (LifeConfiguration (..), directoriesL, filesL, parseLifeConfiguration,+                           renderLifeConfiguration)+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+++configurationSpec :: Spec+configurationSpec = describe "Configuration tests" $ do+    configurationRenderSpec+    configurationPropertySpec++configurationRenderSpec :: Spec+configurationRenderSpec = describe "Pretty rendering" $ do+    it "empty configuration" $+        render mempty `shouldBe` emptyTxt+    it "non-empty configuration" $+        render nonEmptyCfg `shouldBe` nonEmptyTxt+  where+    render :: LifeConfiguration -> Text+    render = renderLifeConfiguration True++    emptyTxt :: Text+    emptyTxt = T.intercalate "\n"+        [ "directories = []"+        , "files = []"+        ]++    nonEmptyCfg :: LifeConfiguration+    nonEmptyCfg = mempty+        & directoriesL .~ one [reldir|foo/|]+        & filesL .~ Set.fromList+            [ [relfile|bar.txt|]+            , [relfile|quux|]+            ]++    nonEmptyTxt :: Text+    nonEmptyTxt = T.intercalate "\n"+        [ "directories = [\"foo/\"]"+        , "files = "+        , "    [ \"bar.txt\""+        , "    , \"quux\""+        , "    ]"+        ]+++configurationPropertySpec :: Spec+configurationPropertySpec = describe "Property Tests" $+    it "parseLifeConfiguration . renderLifeConfiguration cfg ≡ Just cfg"+        parseRenderSpec++parseRenderSpec :: PropertyT IO ()+parseRenderSpec = hedgehog $ do+    cfg <- forAll genLifeConfiguration+    tripping cfg (renderLifeConfiguration True) (parseLifeConfiguration @Maybe)++genLifeConfiguration :: Gen LifeConfiguration+genLifeConfiguration = do+    lifeConfigurationFiles       <- genPathSet genFilePath+    lifeConfigurationDirectories <- genPathSet genDirPath+    let lifeConfigurationBranch = Last $ Just master+    pure LifeConfiguration{..}++-- it's safe to use 'Path' constructor here even if such things are not recommended by API+-- our generators should be safe; and if not - this will be caught by test later+genPathSet :: Gen FilePath -> Gen (Set (Path b t))+genPathSet gen = Set.fromList . fmap Path <$> Gen.list (Range.constant 0 30) gen++genDirPath :: Gen FilePath+genDirPath = (++ [pathSeparator]) <$> genFilePath++genFilePath :: Gen FilePath+genFilePath = foldr1 (</>) <$> Gen.nonEmpty (Range.constant 1 10) genFilePathPiece++genFilePathPiece :: Gen String+genFilePathPiece = Gen.string (Range.constant 1 10) Gen.alphaNum

@@ -1,37 +0,0 @@-module Test.Roundtrip where--import Data.Foldable (foldr1)-import Hedgehog (Gen, Property, forAll, property, tripping)-import Path.Internal (Path (Path))-import System.FilePath (pathSeparator, (</>))--import Life.Configuration (LifeConfiguration (..), parseLifeConfiguration, renderLifeConfiguration)--import qualified Data.Set as Set-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range--hprop_ConfigurationRoundtrip :: Property-hprop_ConfigurationRoundtrip = property $ do-    cfg <- forAll genLifeConfiguration-    tripping cfg (renderLifeConfiguration True) (parseLifeConfiguration @Maybe)--genLifeConfiguration :: Gen LifeConfiguration-genLifeConfiguration = do-    lifeConfigurationFiles       <- genPathSet genFilePath-    lifeConfigurationDirectories <- genPathSet genDirPath-    pure LifeConfiguration{..}---- it's safe to use 'Path' constructor here even if such things are not recommended by API--- our generators should be safe; and if not - this will be caught by test later-genPathSet :: Gen FilePath -> Gen (Set (Path b t))-genPathSet gen = Set.fromList . fmap Path <$> Gen.list (Range.constant 0 30) gen--genDirPath :: Gen FilePath-genDirPath = (++ [pathSeparator]) <$> genFilePath--genFilePath :: Gen FilePath-genFilePath = foldr1 (</>) <$> Gen.nonEmpty (Range.constant 1 10) genFilePathPiece--genFilePathPiece :: Gen String-genFilePathPiece = Gen.string (Range.constant 1 10) Gen.alphaNum