packages feed

system-util (empty) → 0.2

raw patch · 5 files changed

+237/−0 lines, 5 filesdep +basedep +directorydep +easy-datasetup-changed

Dependencies added: base, directory, easy-data, either, filepath, hspec, quickcheck-instances, semigroups, system-lifted, template-haskell, transformers, unix

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, João Cristóvão++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 João Cristóvão 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
+ src/System/Util.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections        #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE CPP #-}++module System.Util+  ( isRW+  , isExe+  , exeExists+  , getShellExe+  , getXdgConfigFolder+  , getDotConfigFolder+  , getHomeFolder+  , getCurrFolder+  , getCustomFolder+  , checkOrCreate+  , tidleExp+  , normFilePath+  , getDefaultShell+  ) where++import Prelude+import Data.Semigroup++import System.Lifted+import System.Directory.Lifted+import System.Environment.Lifted+import System.Posix.User.Lifted+import System.FilePath+import System.IO.Error+import GHC.IO.Exception++import Control.Monad.Trans.Either+import Control.Applicative++------------------------------------------------------------------------------+-- Text Utils ----------------------------------------------------------------+------------------------------------------------------------------------------++type EitherIOException  = EitherT IOException++deriveSystemLiftedErrors "DisallowIOE [HardwareFault]" ''EitherIOException+deriveSystemDirectory   ''EitherIOException+deriveSystemEnvironment ''EitherIOException+deriveSystemPosixUser   ''EitherIOException++isRW :: FilePath -> EitherT IOException IO FilePath+isRW path = do+  perm <- getPermissions path+  if readable perm && writable perm+    then right path+    else left $ mkIOError PermissionDenied+                          "Missing read/write permissions"+                          Nothing (Just path)++isExe :: FilePath -> EitherT IOException IO FilePath+isExe path = do+  perm <- getPermissions path+  if executable perm+    then right path+    else left $ mkIOError PermissionDenied+                          "Missing executable permissions"+                          Nothing (Just path)++doesNotExist :: String -> IOError+doesNotExist str = mkIOError doesNotExistErrorType str+                             Nothing Nothing++-- this could receive a path relative to the current directory or+-- the executable name (in the path).+exeExists :: FilePath -> EitherT IOException IO FilePath+exeExists path = joinMET (doesNotExist "Executable not found")+         $  bimapEitherT id Just (isExe path)+        <> findExecutable path++-- | Check if a executable pointed by the given environement+-- variable exists, and is executable.+getShellExe :: FilePath -> EitherT IOException IO FilePath+getShellExe var = do+  exe <- joinMET ( doesNotExist (  "Variable "+                                <> var+                                <> " not found in current environment")+                 )+       $ lookupEnv var+  exeExists exe++-- | Get configuration folder+-- http://stackoverflow.com/a/1024339/516184+getXdgConfigFolder :: EitherT IOException IO FilePath+getXdgConfigFolder = isRW =<< getEnv "XDG_CONFIG_HOME"++getDotConfigFolder :: EitherT IOException IO FilePath+getDotConfigFolder = do+  home   <- isRW =<< getHomeDirectory+  isRW $ home </> ".config"++getHomeFolder :: EitherT IOException IO FilePath+getHomeFolder = isRW =<< getHomeDirectory++getCurrFolder :: EitherT IOException IO FilePath+getCurrFolder = isRW "."++getCustomFolder :: Maybe FilePath -> EitherT IOException IO FilePath+getCustomFolder fp = case fp of+  Nothing  -> left . userError $ "No path provided"+  Just fp' -> do+      dirExists <- doesDirectoryExist fp'+      if dirExists+        then isRW fp'+        else left $ mkIOError NoSuchThing "Invalid path provided"+                              Nothing (Just fp')++-- | Check if a given directory exists, and if it features Read/Write permissions.+-- If it does not exist, create it.+checkOrCreate :: FilePath -> EitherT IOException IO FilePath+checkOrCreate path = createDirectoryIfMissing True path >> isRW path++-- | Perform tidle expansion so that @~ = $HOME@.+-- It does not handle tidle as $HOME in other places besides first caracter+-- in FilePath+tidleExp :: FilePath -> EitherT IOException IO FilePath+tidleExp fp = do+  home <- getHomeFolder+  right $ case fp of+    ""     -> ""+    (x:xs) -> case x of+      '~' -> case xs of+        []     -> home+        (y:ys) -> if isPathSeparator y then home </> ys else x:xs+      _ -> x:xs++normFilePath :: FilePath -> EitherT IOException IO FilePath+normFilePath fp+  = makeValid . normalise <$> (canonicalizePath =<< tidleExp fp)+++-- | Determine system shell: best effort. Tries @$SHELL@ variable first,+-- then POSIX shell user entry, than in a last effort @/bin/sh@.+getDefaultShell :: EitherT IOException IO FilePath+getDefaultShell = envShell <> nixShell <> wtfShell+  where+    envShell = getEnv "SHELL"+    nixShell = fmap userShell $ getUserEntryForID =<< getRealUserID+    wtfShell = joinMET (mkIOError NoSuchThing "No shell found!" Nothing Nothing)+             $ findExecutable "/bin/sh"
+ system-util.cabal view
@@ -0,0 +1,53 @@+name:            system-util+version:         0.2+license:         BSD3+license-file:    LICENSE+author:          João Cristóvão+maintainer:      jmacristovao@gmail.com+synopsis:        Various system utils lifted to EitherT+description:     Various system functions lifted to EitherT. +                 Provides higher level functions to those in system-lifted.+category:        System+cabal-version:   >= 1.16+build-type:      Simple+homepage:        https://github.com/jcristovao/system-util++library+    exposed-modules: System.Util+    build-depends:   base               >= 4        && < 5+                   , transformers       >= 0.3      && < 0.5+                   , template-haskell   >= 2.5      && < 2.10+                   , either             >= 4.1.1    && < 4.3+                   , semigroups         >= 0.13     && < 0.15+                   , unix               >= 2.6      && < 2.8+                   , directory          >= 1.2.0.1  && < 1.3+                   , filepath           >= 1.3.0.1  && < 1.4+                   , system-lifted      >= 0.2.0.1  && < 0.3+                     +    hs-source-dirs:  src+    ghc-options:     -Wall+    default-language: Haskell2010++++test-suite test+    type:         exitcode-stdio-1.0+    main-is:      main.hs+    hs-source-dirs: test,src+    build-depends:   base               >= 4        && < 5+                   , transformers       >= 0.3+                   , template-haskell   >= 2.5+                   , either             >= 4.1.1+                   , semigroups         >= 0.13     && < 0.15+                   , quickcheck-instances >= 0.3.6+                   , hspec              >= 1.7.2+                   , directory          >= 1.2.0.1+                   , easy-data          >= 0.2+                   , system-lifted      >= 0.2.0+                   , filepath           >= 1.3.0.1++    default-language: Haskell2010++--source-repository head+  --type:     git+  --location: https://github.com/jcristovao/migrationplus
+ test/main.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+