file-command-qq (empty) → 0.1.0.0

raw patch · 5 files changed

+194/−0 lines, 5 filesdep +basedep +parsecdep +processsetup-changed

Dependencies added: base, parsec, process, system-filepath, template-haskell, text

Files

• LICENSE +20/−0
• README.md +39/−0
• Setup.hs +2/−0
• file-command-qq.cabal +25/−0
• src/FileCommand.hs +108/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 Jonathan Fischoff++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:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++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.

@@ -0,0 +1,39 @@+file-command-qq is a simple quasiquoter for running system commands that take a filepath as an argument.++For instance++```+> :set -XOverloadedStrings+> import FileCommand+> import Filesystem.Path+> [s|echo $filename|] "/home/test/thing.txt"+```++will return++```+thing.txt+ExitSuccess+```++You can think of `[s|echo $filename|]` essentially converts into++```haskell+\path -> system $ "echo" ++ encodeString (filename path)+```++All "file parts" start with a '$'. The '$' can be escaped by preceding it with a '\'++There are the following options for "file parts"+++* $path+* $root+* $directory+* $parent+* $filename+* $dirname+* $basename+* $ext++Which correspond to the respective functions in https://hackage.haskell.org/package/system-filepath-0.4.6/docs/Filesystem-Path.html#g:1

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

@@ -0,0 +1,25 @@+-- Initial file-command-qq.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                file-command-qq+version:             0.1.0.0+synopsis:            Quasiquoter for system commands involving filepaths+-- description:         +homepage:            https://github.com/jfischoff/file-command-qq+license:             MIT+license-file:        LICENSE+author:              Jonathan Fischoff+maintainer:          jonathangfischoff@gmail.com+-- copyright:           +category:            System+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:     FileCommand+  -- other-modules:       +  other-extensions:    TemplateHaskell, QuasiQuotes, LambdaCase+  build-depends:       base >=4.7 && <4.8, parsec >=3.1 && <3.2, template-haskell >=2.9 && <2.10, process >=1.2 && <1.3, system-filepath >=0.4 && <0.5, text >=1.1 && <1.2+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,108 @@+{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE LambdaCase #-}+module FileCommand where+import Text.Parsec hiding ((<|>), many)+import Text.Parsec.Char+import Text.Parsec.Combinator+import Control.Applicative+import Control.Monad+import Debug.Trace+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import System.Process+import Filesystem.Path hiding (null, concat)+import Filesystem.Path.CurrentOS (encodeString)+import Data.Maybe+import qualified Data.Text as T++type Parser = Parsec String ()++data FilePart +  = Path     +  | Root     +  | Directory+  | Parent   +  | FileName +  | DirName  +  | BaseName +  | Ext      +  deriving (Show, Eq)+  +pFilePart :: Parser FilePart+pFilePart = char '$' *> pFilePart'+  +pFilePart' :: Parser FilePart+pFilePart' +   =  Path      <$ string "path"+  <|> Root      <$ string "root"+  <|> Directory <$ string "directory"+  <|> Parent    <$ string "parent"+  <|> FileName  <$ string "filename"+  <|> DirName   <$ string "dirname"+  <|> BaseName  <$ string "basename"+  <|> Ext       <$ string "ext"+      +type Cmd = String++pCmd :: Parser Cmd+pCmd = do +  frag <- many $ noneOf "\\$"+  xs <- option [] $ try $ do +    slash <- char '\\'+    c     <- anyChar+    return $ [slash, c]+  case xs of +    [] +     | null frag -> fail "empty cmd fragment"+     | otherwise -> return frag+    "\\$" -> return $ frag ++ "$"+    xs'   -> return $ frag ++ xs'++data Expr +  = ECmd      Cmd+  | EFilePart FilePart+  deriving (Show, Eq)++pExpr :: Parser Expr+pExpr = EFilePart <$> pFilePart <|> ECmd <$> pCmd ++parser :: Parser [Expr]+parser = many1 pExpr++eval :: [Expr] -> Q Exp+eval xs = do +  filePathName <- newName "filePath"+  let qs = map (evalExpr filePathName) xs+  let body = [|system $ concat $ $(listE qs) |]+  lamE [varP filePathName] body++evalExpr :: Name -> Expr -> Q Exp+evalExpr filePathName = \case+  ECmd      frag     -> [| $(stringE frag) |]+  EFilePart filePart -> evalFilePart filePathName filePart+  +evalFilePart :: Name -> FilePart -> Q Exp +evalFilePart filePathName = \case+  Path         -> [| encodeString $(varE filePathName) |]+  Root         -> [| encodeString $ root      $(varE filePathName) |]+  Directory    -> [| encodeString $ directory $(varE filePathName) |]+  Parent       -> [| encodeString $ parent    $(varE filePathName) |]+  FileName     -> [| encodeString $ filename  $(varE filePathName) |]+  DirName      -> [| encodeString $ dirname   $(varE filePathName) |]+  BaseName     -> [| encodeString $ basename  $(varE filePathName) |]+  Ext          -> [| T.unpack +                   $ fromMaybe +                      (error +                      $ "Failed to get extension for " ++ encodeString $(varE filePathName)+                      )+                      $ extension $(varE filePathName) +                   |]++s :: QuasiQuoter +s = QuasiQuoter +     { quoteExp  = either (error . show) eval . parse parser "" +     , quotePat  = error "s quotePat not implemented"+     , quoteType = error "s quoteType not implemented"+     , quoteDec  = error "s quoteDec not implemented"+     }