dot-linker (empty) → 0.1.0.0
raw patch · 7 files changed
+385/−0 lines, 7 filesdep +HUnitdep +attoparsecdep +basesetup-changed
Dependencies added: HUnit, attoparsec, base, bytestring, dot-linker, system-filepath, tasty, tasty-hunit, text, turtle, unix, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +29/−0
- dot-linker.cabal +65/−0
- src/DotLinker.hs +74/−0
- src/DotLinker/Parsers.hs +62/−0
- test/Test.hs +123/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -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
+ dot-linker.cabal view
@@ -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
+ src/DotLinker.hs view
@@ -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
+ src/DotLinker/Parsers.hs view
@@ -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)
+ test/Test.hs view
@@ -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