module System.Win32.HPPath
( winPath
, unWinPath
, mapWinPath
, clearPath
, addHPPath
, isVersionOpt
, WinPath(getWinPath)
)
where
import Data.List (intercalate, isInfixOf)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
newtype WinPath = WinPath { getWinPath :: [FilePath] }
hpMaster :: FilePath
hpMaster = "C:\\Program Files\\Haskell\\bin"
hpInitialSubpaths :: [FilePath]
hpInitialSubpaths =
[ "lib\\extralibs\\bin"
, "bin"
]
hpFinalSubpaths :: [FilePath]
hpFinalSubpaths = ["mingw\\bin"]
winPath :: String -> WinPath
winPath = WinPath . splitOn ";"
unWinPath :: WinPath -> String
unWinPath = intercalate ";" . getWinPath
mapWinPath :: (WinPath -> WinPath) -> String -> String
mapWinPath f = unWinPath . f . winPath
clearPath :: WinPath -> WinPath
clearPath = WinPath . filter (not . ("Haskell" `isInfixOf`)) . getWinPath
addHPPath :: FilePath -> WinPath -> WinPath
addHPPath hp =
WinPath
. (hpMaster :)
. (map prependHp hpInitialSubpaths ++)
. (++ map prependHp hpFinalSubpaths)
. getWinPath
where
prependHp = (hp' ++)
hp'
| endsWith '\\' hp = unquote hp
| otherwise = unquote hp ++ "\\"
unquote :: String -> String
unquote = unbracket '"' '"'
unbracket :: Eq a => a -> a -> [a] -> [a]
unbracket l r xs@(x:xs') | x == l = fromMaybe xs $ dropFromEnd r xs'
unbracket _ _ xs = xs
dropFromEnd :: Eq a => a -> [a] -> Maybe [a]
dropFromEnd x [y] | x == y = Just []
dropFromEnd x (y:ys) = fmap (y:) $ dropFromEnd x ys
dropFromEnd _ _ = Nothing
endsWith :: Eq a => a -> [a] -> Bool
endsWith x [y] = x == y
endsWith x (_:ys) = endsWith x ys
endsWith _ _ = False
isVersionOpt :: String -> Bool
isVersionOpt =
(`elem`
[ "/?"
, "/v"
, "/version"
, "/h"
, "/help"
, "-v"
, "--version"
, "-h"
, "--help"
]
)