{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, TupleSections #-}
module Util(
Str,
FilePathEq, filePathEq,
PackageName, ModuleName, IdentName,
parseHanging,
parseHanging2, unindent2,
(?:),
isHaskellCtor,
isHaskellSymbol,
reachable,
isPathsModule,
cmd, cmdStdout
) where
import Data.Char
import Data.Monoid
import Data.Hashable
import Data.List.Extra
import Data.Tuple.Extra
import System.Process
import System.FilePath
import System.Directory
import System.Info.Extra
import System.Console.CmdArgs.Verbosity
import Str(Str)
import qualified Str as S
import qualified Data.HashSet as Set
import Prelude
type PackageName = String
type ModuleName = String
type IdentName = String
(?:) :: (Eq a, Monoid a) => a -> a -> a
a ?: b = if a == mempty then b else a
parseHanging :: [String] -> [(String, [String])]
parseHanging = repeatedly (\(x:xs) -> first (\a -> (x, unindent a)) $ span (maybe True ((== ' ') . fst) . uncons) xs)
parseHanging2 :: [Str] -> [(Str, [Str])]
parseHanging2 = repeatedly (\(x:xs) -> first (x,) $ span (maybe True ((== ' ') . fst) . S.uncons) xs)
unindent :: [String] -> [String]
unindent xs = map (drop n) xs
where
n = minimum $ top : map f xs
f x = let (a,b) = span isSpace x in if null b then top else length a
top = 1000
unindent2 :: [Str] -> [Str]
unindent2 xs = map (S.drop n) xs
where
n = minimum $ top : map f xs
f x = let (a,b) = S.span isSpace x in if S.null b then top else S.length a
top = S.ugly 1000
isHaskellSymbol :: Char -> Bool
isHaskellSymbol x =
x `elem` ("!#$%&*+./<=>?@\\^|-~" :: String) ||
(isSymbol x && x `notElem` ("\"'_(),;[]`{}" :: String))
isHaskellCtor :: IdentName -> Bool
isHaskellCtor [] = False
isHaskellCtor (x:xs) = isUpper x || x == ':'
newtype FilePathEq = FilePathEq FilePath
deriving (Hashable,Eq,Ord,Show)
filePathEq :: FilePath -> FilePathEq
filePathEq = FilePathEq . (if isWindows || isMac then lower else id) . normalise
reachable :: (Eq k, Hashable k) => (k -> [k]) -> [k] -> Set.HashSet k
reachable follow = f Set.empty
where
f done [] = done
f done (x:xs)
| x `Set.member` done = f done xs
| otherwise = f (Set.insert x done) $ follow x ++ xs
isPathsModule :: ModuleName -> Bool
isPathsModule = isPrefixOf "Paths_"
cmdTrace :: FilePath -> [String] -> IO ()
cmdTrace exe args = whenLoud $ do
dir <- getCurrentDirectory
putStrLn $ "Running: " ++ showCommandForUser exe args ++ " (in " ++ dir ++ ")"
cmd :: FilePath -> [String] -> IO ()
cmd exe args = do
cmdTrace exe args
callProcess exe args
cmdStdout :: FilePath -> [String] -> IO String
cmdStdout exe args = do
cmdTrace exe args
readCreateProcess (proc exe args) ""