Workspace.hs (1990B)
1 module Module.Workspace 2 ( Workspace(..) 3 , emptyWorkspace 4 , lookupWorkspaceModule 5 , findWorkspaceFor 6 , parseWorkspace 7 ) where 8 9 import Data.Char (isSpace) 10 import qualified Data.Map as Map 11 import qualified Data.Text as T 12 import System.Directory (doesDirectoryExist, doesFileExist) 13 import System.FilePath (takeDirectory, (</>)) 14 15 data Workspace = Workspace 16 { workspaceRoot :: FilePath 17 , workspaceModules :: Map.Map T.Text FilePath 18 } deriving (Show, Eq) 19 20 emptyWorkspace :: Workspace 21 emptyWorkspace = Workspace "" Map.empty 22 23 lookupWorkspaceModule :: Workspace -> T.Text -> Maybe FilePath 24 lookupWorkspaceModule (Workspace root modules) name = (root </>) <$> Map.lookup name modules 25 26 findWorkspaceFor :: FilePath -> IO Workspace 27 findWorkspaceFor sourcePath = search (takeDirectory sourcePath) 28 where 29 search dir = do 30 let path = dir </> "tricu.workspace" 31 exists <- doesFileExist path 32 if exists 33 then parseWorkspaceAt dir <$> readFile path 34 else do 35 let parent = takeDirectory dir 36 if parent == dir 37 then return emptyWorkspace 38 else do 39 parentExists <- doesDirectoryExist parent 40 if parentExists then search parent else return emptyWorkspace 41 42 parseWorkspace :: String -> Workspace 43 parseWorkspace = parseWorkspaceAt "" 44 45 parseWorkspaceAt :: FilePath -> String -> Workspace 46 parseWorkspaceAt root input = Workspace root $ Map.fromList 47 [ (T.pack name, path) 48 | raw <- lines input 49 , Just (name, path) <- [parseLine raw] 50 ] 51 52 parseLine :: String -> Maybe (String, FilePath) 53 parseLine raw = 54 let line = trim (takeWhile (/= '#') raw) 55 in case words line of 56 [] -> Nothing 57 ["module", name, "=", path] -> Just (name, stripQuotes path) 58 _ -> Nothing 59 60 trim :: String -> String 61 trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse 62 63 stripQuotes :: String -> String 64 stripQuotes s = case s of 65 ('"':rest) | not (null rest) && last rest == '"' -> init rest 66 _ -> s