file-templates (empty) → 1.0.0.0

raw patch · 3 files changed

+219/−0 lines, 3 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, directory, filepath, foundation, transformers, unordered-containers

Files

Setup.hs +2/−0
file-templates.cabal +27/−0
src/Main.hs +190/−0

+ Setup.hs view

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

+ file-templates.cabal view

@@ -0,0 +1,27 @@+name: file-templates+version: 1.0.0.0+cabal-version: >=1.10+build-type: Simple+license: BSD3+copyright: BSD3+maintainer: anfelor@posteo.de+homepage: https://github.com/anfelor/file-templates#readme+synopsis: Use templates for files and directories+category: Web+author: Anton Felix Lorenzen++executable new+    main-is: Main.hs+    build-depends:+        base >=4.7 && <5,+        foundation >=0.0.9 && <0.1,+        directory >=1.3.0.0 && <1.4,+        attoparsec >=0.13.1.0 && <0.14,+        filepath >=1.4.1.1 && <1.5,+        bytestring >=0.10.8.1 && <0.11,+        unordered-containers >=0.2.8.0 && <0.3,+        transformers >=0.5.2.0 && <0.6+    default-language: Haskell2010+    default-extensions: NoImplicitPrelude OverloadedStrings+    hs-source-dirs: src+

+ src/Main.hs view

@@ -0,0 +1,190 @@+module Main where++import Foundation+import Control.Exception+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Strict+import Data.ByteString (ByteString)+import Data.HashMap.Strict (HashMap)+import Data.Traversable+import qualified Data.Attoparsec.ByteString as Attoparsec+import qualified Data.ByteString+import qualified Data.ByteString.Char8+import qualified Data.Char+import qualified Data.HashMap.Strict as HashMap+import qualified Data.List+import qualified GHC.Base+import qualified System.Environment+import qualified System.Exit+import System.Directory+import System.FilePath+++-- | Files and file names are parsed into a list of this type.+data Content+  = PromptVar ByteString -- ^ prompt the user for a substitution+  | EnvVar ByteString -- ^ a shell environment variable+  | String ByteString -- ^ normal text+++-- | Parse one chunk of 'Content'.+parseChunk :: Attoparsec.Parser Content+parseChunk = Attoparsec.choice+  [ do s <- Attoparsec.takeWhile1 (/=questionMark) -- '?' question mark+       pure (String s)+  , Attoparsec.try $ do+      Attoparsec.word8 questionMark+      mode <- Attoparsec.takeWhile validChar+      Attoparsec.word8 questionMark+      name <- Attoparsec.takeWhile validChar+      Attoparsec.word8 questionMark+      case mode of+        "env" -> pure $ EnvVar name+        "" -> pure $ PromptVar name+        _ -> fail $ "Couldn't recognize mode: " <> bsToChars mode++    -- Allow for stand-alone question marks, like in the common ternary operator ? :+  , (String . Data.ByteString.singleton) <$> Attoparsec.word8 questionMark+  ]+  where+    questionMark = 63+    space = 32+    validChar c = c /= questionMark+               && c /= space+++bsToChars :: ByteString -> [Char]+bsToChars = fmap (Data.Char.chr . fromIntegral) . Data.ByteString.unpack+++charsToBs :: [Char] -> ByteString+charsToBs = Data.ByteString.pack . fmap (fromIntegral . Data.Char.ord)+++parseBS :: ByteString -> Either GHC.Base.String [Content]+parseBS = Attoparsec.parseOnly (Attoparsec.many' parseChunk <* Attoparsec.endOfInput)+++-- | Given a list of variables, that the user has already given a meaning to,+-- convert a list of 'Content's into a bytestring, by substituting the strings+-- given by the user and the content of environment variables for the 'Content' variables+-- and concatenating the resulting strings (without spaces, etc.).+convert :: [Content] -> StateT (HashMap ByteString ByteString) IO ByteString+convert con = do+  asked <- get+  bss <- forM con $ \c -> case c of+    String bs -> pure bs+    EnvVar var -> do+      menv <- lift $ System.Environment.lookupEnv (bsToChars var)+      case menv of+        Nothing -> lift $ throwIO $ CouldntFindEnvVar var+        Just str -> pure $ charsToBs str+    PromptVar var ->+      case HashMap.lookup var asked of+        Just res -> pure res+        Nothing -> do+          lift $ Data.ByteString.putStr $ "Please give a value for '" <> var <> "': "+          res <- lift Data.ByteString.getLine+          modify' (HashMap.insert var res)+          pure res+  pure (mconcat bss)+++-- | Return all files in a directory.+-- > allFiles "/home/xyz"+-- [".zsh_rc", "Documents/CV.docx", ..]+allFiles :: FilePath -> IO [FilePath]+allFiles = flip go ""+  where+    go dir prefix = do+      content <- listDirectory dir+      dirs <- filterM (doesDirectoryExist . (</>) dir) content+      subfiles <- mconcat <$> traverse (\d -> go (dir </> d) (prefix </> d)) dirs+      let files = fmap (prefix </>) $ diff content dirs+      pure $ files <> subfiles++    -- Unlike \\, this works in O(n) time relative to the first list.+    diff (x:xs) (y:ys) | x == y = diff xs ys+    diff (x:xs) (y:ys) | x /= y = x : diff xs (y:ys)+    diff xs [] = xs+    diff [] ys = undefined+++data TemplateExceptions+  = CouldntParseFilename ByteString GHC.Base.String -- ^ name and attoparsec info+  | CouldntParseFile ByteString GHC.Base.String -- ^ name and attoparsec info+  | CouldntFindEnvVar ByteString+  deriving (Eq, Show)++instance Exception TemplateExceptions where+  displayException (CouldntParseFilename name info) =+    "Couldn't parse filename '" <> bsToChars name <> "': \n" <> info+  displayException (CouldntParseFile name info) =+    "Couldn't parse file '" <> bsToChars name <> "': \n" <> info+  displayException (CouldntFindEnvVar var) =+    "Couldn't find the environment variable '" <> bsToChars var <> "'."+++-- | Print the first argument and then the second,+-- and wait for 'j' or 'n' (spaces get trimmed, case-insensitive).+-- When the user enters something else, print the second argument+-- and wait for another input and so forth.+-- > askUser "This is bad." "Continue? [j/N]"+askUser :: ByteString -> ByteString -> IO Bool+askUser msg repeat = do+  Data.ByteString.Char8.putStrLn msg+  go+  where+    go = do+      Data.ByteString.Char8.putStr repeat+      r <- Data.ByteString.Char8.getLine+      let trimmed = fst $ Data.ByteString.Char8.spanEnd Data.Char.isSpace+                        $ Data.ByteString.Char8.dropWhile Data.Char.isSpace r+      let lower = Data.ByteString.Char8.map Data.Char.toLower trimmed+      case lower of+        "j" -> pure True+        "n" -> pure False+        _ -> go+++main :: IO ()+main = do+  [name] <- getArgs+  templateDir <- (</> toList name) <$> getAppUserDataDirectory "templates"+  templateFiles <- allFiles templateDir++  -- Parse the filenames and resolve the variables in them.+  (destFiles, asked) <- runStateT+    (mapM (convert <=< parseFilename . charsToBs) templateFiles)+    HashMap.empty++  -- Check whether some files are already present.+  existingFiles <- filterM (doesFileExist . bsToChars) destFiles+  when (not $ null existingFiles) $ do+    overwrite <- askUser+      ("The following files already exist:\n"+      <> Data.ByteString.Char8.unlines (fmap ("  "<>) existingFiles)+      ) "Overwrite? [y/N]"+    when (not overwrite) $ do+      System.Exit.exitFailure++  -- Copy the file content.+  flip evalStateT asked+    $ forM_ (Data.List.zip (fmap (templateDir </>) templateFiles)+                           (fmap bsToChars destFiles))+    $ \(tf, df) -> do+      bs <- lift $ Data.ByteString.readFile tf+      cs <- parseFile df bs+      completed <- convert cs+      lift $ createDirectoryIfMissing True (dropFileName df)+      lift $ Data.ByteString.writeFile df completed++  where+    parseFilename bs = case parseBS bs of+      Right a -> pure a+      Left s -> lift $ throwIO $ CouldntParseFilename bs s++    parseFile name bs = case parseBS bs of+      Right a -> pure a+      Left s -> lift $ throwIO $ CouldntParseFile (Data.ByteString.Char8.pack name) s