diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Pedro Rodriguez Tavarez (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Pedro Rodriguez Tavarez nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main(main) where + +import Data.Attoparsec.ByteString (parseOnly) +import Data.Text.Encoding (encodeUtf8) +import Data.Text (pack) +import qualified Data.HashMap.Strict as M +import DotLinker +import Turtle +import Prelude hiding (FilePath) + +main :: IO () +main = sh $ do + (dots, mapFileLoc, dryRun, verbose) <- options "dot-linker" parseOpts + mapFile <- liftIO $ encodeUtf8 <$> readTextFile mapFileLoc + let entriesE = toHashMap <$> parseOnly fileMapParser mapFile + parsedMap <- either (die . pack) return entriesE + expandedMap <- traverse (sequenceA . map expandPath) parsedMap + cd dots + file <- filename <$> ls "./" + matchAndLink (verbose, dryRun) expandedMap file + where + parseOpts = (,,,) <$> parseDotsPath <*> parseMapPath <*> parseDry <*> parserVersbosity + parseDotsPath = argPath "dots_dir" "Directory where the dot files are located" + parseMapPath = argPath "mappings_file" "Path to the mappings file" + parseDry = switch "dry-run" 'd' "Do not link anything, simply show what would happen" + parserVersbosity = switch "verbose" 'v' "Increase verbosity" + + toHashMap = M.fromList diff --git a/dot-linker.cabal b/dot-linker.cabal new file mode 100644 --- /dev/null +++ b/dot-linker.cabal @@ -0,0 +1,65 @@ +name: dot-linker +version: 0.1.0.0 +cabal-version: >=1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: 2016 Pedro Rodriguez Tavarez +maintainer: pedro@pjrt.co +homepage: https://github.com/pjrt/Dot-Linker#readme +synopsis: Initial project template from stack +description: + Please see README.md +category: Util +author: Pedro Rodriguez Tavarez + +source-repository head + type: git + location: https://github.com/pjrt/Dot-Linker + +library + exposed-modules: + DotLinker + DotLinker.Parsers + build-depends: + base >=4.8.2.0 && <4.9, + attoparsec >=0.13.0.2 && <0.14, + bytestring >=0.10.6.0 && <0.11, + turtle >=1.2.8 && <1.3, + text >=1.2.2.1 && <1.3, + system-filepath >=0.4.13.4 && <0.5, + unix >=2.7.1.0 && <2.8, + unordered-containers >=0.2.7.1 && <0.3 + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + +executable dot-linker + main-is: Main.hs + build-depends: + base >=4.8.2.0 && <4.9, + attoparsec >=0.13.0.2 && <0.14, + dot-linker >=0.1.0.0 && <0.2, + turtle >=1.2.8 && <1.3, + text >=1.2.2.1 && <1.3, + unordered-containers >=0.2.7.1 && <0.3 + default-language: Haskell2010 + hs-source-dirs: app + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +test-suite dot-linker-spec + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: + base >=4.8.2.0 && <4.9, + bytestring >=0.10.6.0 && <0.11, + dot-linker >=0.1.0.0 && <0.2, + HUnit >=1.3.1.1 && <1.4, + tasty >=0.11.0.3 && <0.12, + tasty-hunit >=0.9.2 && <0.10, + attoparsec >=0.13.0.2 && <0.14, + turtle >=1.2.8 && <1.3, + unordered-containers >=0.2.7.1 && <0.3 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall diff --git a/src/DotLinker.hs b/src/DotLinker.hs new file mode 100644 --- /dev/null +++ b/src/DotLinker.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +module DotLinker +( lineMapParser +, fileMapParser +, matchAndLink +, expandPath +, Entry +) where + +import Control.Applicative +import Control.Monad (forM_, unless, when) +import Data.Attoparsec.ByteString.Char8 +import qualified Data.HashMap.Strict as M +import Data.List (foldl') +import Data.Text (Text, pack, unpack) +import Data.Text.Encoding (decodeUtf8) +import Filesystem.Path.CurrentOS (FilePath, encode) +import System.Posix.Files (createSymbolicLink) +import Prelude hiding (takeWhile, FilePath) +import Turtle ((), (<>), MonadIO, fromText, toText, liftIO) +import qualified Turtle as T + +import DotLinker.Parsers + +type MappedDots = M.HashMap Text [FilePath] + +-- | Given a map of dot files to their location and a dot file, make a symbolic +-- link for the given dotfile IFF a mapping is found. +-- +-- If the dry run flag is passed, it won't link anything +-- +-- NOTE: If the symbolic link already exists or there is no mapping in for the +-- given file, this does nothing. +matchAndLink :: (MonadIO io) => (Bool, Bool) -> MappedDots -> FilePath -> io () +matchAndLink (v, dryRun) mapped dotfile = do + let dotfileAsText = asText . T.filename $ dotfile + targetM = M.lookup dotfileAsText mapped + maybe (unmatchFile $ asText dotfile) matchedFiles targetM + where + unmatchFile df = vEcho $ "No match found for dotfile " <> df <> ". Skipping..." + matchedFiles targets = forM_ targets $ \target -> do + targetExists <- (||) <$> T.testfile target <*> T.testdir target + if targetExists + then vEcho $ asText dotfile <> " already exists. Skipping..." + else do + realdotfile <- T.realpath dotfile + ensurePathExist target + T.echo $ "Linking " <> asText realdotfile <> " -> " <> asText target + unless dryRun $ lns realdotfile target + where + ensurePathExist = T.mktree . T.directory + + vEcho = when v . T.echo + +-- | Expand any enviroment variables found in the path +expandPath :: MonadIO io => FilePath -> io FilePath +expandPath path = do + parts <- either (T.die . pack) (traverse expand) $ parseOnly envParser (encode path) + return $ foldl' (\a x -> a fromText x) "/" parts + where + expand (Lit p) = return $ decodeUtf8 p + expand (Env e) = + let dieMsg = decodeUtf8 $ "Enviroment " <> e <> " not set" + in maybe (T.die dieMsg) return =<< T.need (decodeUtf8 e) + +-- | Create a symbolic link (ln -s) +lns :: MonadIO io => FilePath -> FilePath -> io () +lns src target = liftIO $ createSymbolicLink (toText' src) (toText' target) + where toText' = unpack . asText + +-- Utils ---------------------------------------------------------------------- +-- TODO:pjrt this is lazy and probably wrong +asText :: FilePath -> Text +asText = either id id . toText diff --git a/src/DotLinker/Parsers.hs b/src/DotLinker/Parsers.hs new file mode 100644 --- /dev/null +++ b/src/DotLinker/Parsers.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +module DotLinker.Parsers +( lineMapParser +, envParser +, fileMapParser +, Entry +, EnvOrLit(..) +) where + +import Control.Applicative +import Data.Attoparsec.ByteString.Char8 +import Data.ByteString (ByteString) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8) +import Filesystem.Path.CurrentOS (FilePath, decode) +import Prelude hiding (takeWhile, FilePath) + +type Entry = (Text, [FilePath]) + +-- | Parser for a single line in the file +-- +-- Example: +-- +-- vimrc: /home/rar/.vimrc,/home/rar/.config/nvim/init.vim +lineMapParser :: Parser Entry +lineMapParser = do + src <- dotName <* char ':' + ts <- filePath `sepBy1` char ',' + return (decodeUtf8 src, ts) + where + dotName = takeTill (== ':') + filePath = + strip $ decode <$> takeTill (inClass ",\n\r") + + strip str = many' space *> str <* many' space + +-- | Parser for a whole file +fileMapParser :: Parser [Entry] +fileMapParser = catMaybes <$> optLineMapParser `manyTill` endOfInput + where + optLineMapParser = (string "-- " *> skip1 lineMapParser *> return Nothing) <|> (Just <$> lineMapParser) + skip1 p = sc + where sc = (p *> pure ()) <|> pure () + +data EnvOrLit = Env ByteString -- ^ Represents an enviroment variable + | Lit ByteString -- ^ A literal path part + +-- | Parser that parses a path with variables into parts +-- +-- Example: $HOME/.dotfiles -> [Env HOME, Lit .dotfiles] +-- +-- This will later be used by @expandPath@ to create: +-- +-- [Env Home, Lit .dotfiles] -> /home/me/.dotfiles +envParser :: Parser [EnvOrLit] +envParser = secParser `sepBy1` char '/' + where + secParser = + let env = char '$' *> takeWhile (inClass "a-zA-Z_") "env variable" + lit = takeTill (== '/') "literal path part" + in (Env <$> env) <|> (Lit <$> lit) diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Data.Attoparsec.ByteString +import Data.Monoid +import Data.ByteString.Char8 +import DotLinker +import Turtle ((), liftIO) +import qualified Turtle as T +import Test.Tasty +import Test.Tasty.HUnit +import qualified Data.HashMap.Strict as M + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "file parser" + [ lineparserTest, commentedLineTest, fileparserTests, ioTests] +entry :: a -> b -> (a, b) +entry = (,) + +lineparserTest :: TestTree +lineparserTest = + testCase "should parse a line fine" $ + let x = parseOnly lineMapParser "vim_rc: /root/har/.vimrc, /root/har/.config/nvim/init.vim" + expected = Right $ entry "vim_rc" ["/root/har/.vimrc", "/root/har/.config/nvim/init.vim"] + in x @?= expected + +commentedLineTest :: TestTree +commentedLineTest = + testCase "should not parse a commented line" $ + let x = parseOnly fileMapParser + $ "vimrc: /root/har/.vimrc, /root/har/.config/nvim/init.vim\n" <> + "-- ctags: /root/har/.ctags\n" <> + "zshrc: /root/har/.zshrc\n" + expected = Right + [ entry "vimrc" ["/root/har/.vimrc", "/root/har/.config/nvim/init.vim"] + , entry "zshrc" ["/root/har/.zshrc"] + ] + in x @?= expected + + +fileparserTests :: TestTree +fileparserTests = + testGroup "File parser tests" + [fileparserTest "\n", fileparserTest "\r", fileparserTest "\n\r"] + +fileparserTest :: ByteString -> TestTree +fileparserTest endLineChar = + testCase ("should parse multiple lines fine with " <> show endLineChar) $ + let x = parseOnly fileMapParser + $ "vimrc: /root/har/.vimrc, /root/har/.config/nvim/init.vim" + <> endLineChar <> "zshrc: /root/har/.zshrc" <> endLineChar + expected = Right + [ entry "vimrc" ["/root/har/.vimrc", "/root/har/.config/nvim/init.vim"] + , entry "zshrc" ["/root/har/.zshrc"] + ] + in x @?= expected + + +ioTests :: TestTree +ioTests = testGroup "IO tests" [dirMakeTest, envParserTest] + +mkTestDir :: T.Managed (M.HashMap T.Text [T.FilePath], T.FilePath, T.FilePath) +mkTestDir = + do parent <- T.pwd + testPath <- T.mktempdir parent "test-dir" + let dotFile = "something.link" + dotFilePath = testPath dotFile + expectedFile = testPath "non-existent-dir" "ned" dotFile + mappedDots = M.fromList [(toText' dotFile, [expectedFile])] + T.touch dotFilePath + return (mappedDots, dotFilePath, expectedFile) + + +dirMakeTest :: TestTree +dirMakeTest = + testCase "in `/a/b/c.link`, if `b` doesn't exist, it should be made" $ + T.runManaged $ + do (mappedDots, dotFilePath, expectedFile) <- mkTestDir + matchAndLink (False, False) mappedDots dotFilePath + liftIO $ assertBool (show expectedFile ++ " does not exist") + =<< T.testfile expectedFile + +dryRunTest :: TestTree +dryRunTest = + testCase "dry run should not link anything" $ + T.runManaged $ + do (mappedDots, dotFilePath, expectedFile) <- mkTestDir + matchAndLink (False, True) mappedDots dotFilePath + liftIO $ assertBool (show expectedFile ++ " does exist") . not + =<< T.testfile expectedFile + +envParserTest :: TestTree +envParserTest = testGroup "Enviroment Parsing" [midPath, beginning, multi] + where + midPath = + testCase "envParser should parse env variables mid path" + $ do let exportedPath = "/home/har" + T.export "TEST_HOME" (toText' exportedPath) + expanedPath <- expandPath "/root/$TEST_HOME/.dort/lol" + let expectedPath = "/root" exportedPath ".dort/lol" + expanedPath @?= expectedPath + beginning = + testCase "envParser should parse env variables at the beginning" + $ do let exportedPath = "/home/har" + T.export "TEST_HOME" (toText' exportedPath) + expanedPath <- expandPath "$TEST_HOME/.dort/lol" + let expectedPath = exportedPath ".dort/lol" + expanedPath @?= expectedPath + multi = + testCase "envParser should parse env multiple variables" + $ do let exportedPath1 = "/home/har" + exportedPath2 = "hor/" + T.export "TEST_HOME" (toText' exportedPath1) + T.export "TEST_dir" (toText' exportedPath2) + expanedPath <- expandPath "$TEST_HOME/.dort/$TEST_dir/har" + let expectedPath = exportedPath1 ".dort" exportedPath2 "har" + expanedPath @?= expectedPath + +toText' :: T.FilePath -> T.Text +toText' = either id id . T.toText