67 lines
1.9 KiB
Haskell
67 lines
1.9 KiB
Haskell
module Module.Workspace
|
|
( Workspace(..)
|
|
, emptyWorkspace
|
|
, lookupWorkspaceModule
|
|
, findWorkspaceFor
|
|
, parseWorkspace
|
|
) where
|
|
|
|
import Data.Char (isSpace)
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Text as T
|
|
import System.Directory (doesDirectoryExist, doesFileExist)
|
|
import System.FilePath (takeDirectory, (</>))
|
|
|
|
data Workspace = Workspace
|
|
{ workspaceRoot :: FilePath
|
|
, workspaceModules :: Map.Map T.Text FilePath
|
|
} deriving (Show, Eq)
|
|
|
|
emptyWorkspace :: Workspace
|
|
emptyWorkspace = Workspace "" Map.empty
|
|
|
|
lookupWorkspaceModule :: Workspace -> T.Text -> Maybe FilePath
|
|
lookupWorkspaceModule (Workspace root modules) name = (root </>) <$> Map.lookup name modules
|
|
|
|
findWorkspaceFor :: FilePath -> IO Workspace
|
|
findWorkspaceFor sourcePath = search (takeDirectory sourcePath)
|
|
where
|
|
search dir = do
|
|
let path = dir </> "tricu.workspace"
|
|
exists <- doesFileExist path
|
|
if exists
|
|
then parseWorkspaceAt dir <$> readFile path
|
|
else do
|
|
let parent = takeDirectory dir
|
|
if parent == dir
|
|
then return emptyWorkspace
|
|
else do
|
|
parentExists <- doesDirectoryExist parent
|
|
if parentExists then search parent else return emptyWorkspace
|
|
|
|
parseWorkspace :: String -> Workspace
|
|
parseWorkspace = parseWorkspaceAt ""
|
|
|
|
parseWorkspaceAt :: FilePath -> String -> Workspace
|
|
parseWorkspaceAt root input = Workspace root $ Map.fromList
|
|
[ (T.pack name, path)
|
|
| raw <- lines input
|
|
, Just (name, path) <- [parseLine raw]
|
|
]
|
|
|
|
parseLine :: String -> Maybe (String, FilePath)
|
|
parseLine raw =
|
|
let line = trim (takeWhile (/= '#') raw)
|
|
in case words line of
|
|
[] -> Nothing
|
|
["module", name, "=", path] -> Just (name, stripQuotes path)
|
|
_ -> Nothing
|
|
|
|
trim :: String -> String
|
|
trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
|
|
|
|
stripQuotes :: String -> String
|
|
stripQuotes s = case s of
|
|
('"':rest) | not (null rest) && last rest == '"' -> init rest
|
|
_ -> s
|