on 9488ba6 help sign in
elk/builder/src/File/Find.hs
109 lines 3.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module File.Find
4 ( Asset(..)
5 , find
6 )
7 where
9import Control.Monad.Except (liftIO)
10import qualified Data.Map as Map
11import qualified Data.Maybe as Maybe
12import qualified System.FilePath as FP
13import qualified System.Directory as Dir
14import System.FilePath ((</>), (<.>))
16import qualified Elm.Compiler.Module as Module
17import qualified Elm.Name as N
18import qualified Elm.Package as Pkg
20import qualified Elm.Project.Json as Project
21import qualified Elm.Project.Summary as Summary
22import qualified Reporting.Exit.Crawl as E
23import qualified Reporting.Task as Task
27-- ASSET
30data Asset
31 = Local FilePath
32 | Kernel FilePath (Maybe FilePath)
33 | Foreign Pkg.Package
34 | ForeignKernel
38-- FIND
41find :: Summary.Summary -> E.Origin -> Module.Raw -> Task.Task_ E.Problem Asset
42find (Summary.Summary root project exposed _ _) origin name =
43 do here <- liftIO Dir.getCurrentDirectory
44 let toRoot dir = FP.makeRelative here (root </> dir)
45 case project of
46 Project.App info ->
47 do let srcDirs = map toRoot (Project._app_source_dirs info)
48 findElm srcDirs exposed origin name
50 Project.Pkg _ ->
51 if N.startsWith "Elm.Kernel." name then
52 if Project.isPlatformPackage project then
53 findKernel (toRoot "src") exposed origin name
54 else
55 Task.throw $ E.ModuleNameReservedForKernel origin name
57 else
58 findElm [ toRoot "src" ] exposed origin name
62-- FIND ELM
65findElm :: [FilePath] -> Summary.ExposedModules -> E.Origin -> Module.Raw -> Task.Task_ E.Problem Asset
66findElm srcDirs exposed origin name =
67 do
68 paths <- liftIO $ Maybe.catMaybes <$> mapM (elmExists name) srcDirs
70 case (paths, Map.lookup name exposed) of
71 ([path], Nothing) ->
72 return (Local path)
74 ([], Just [pkg]) ->
75 return (Foreign pkg)
77 ([], Nothing) ->
78 Task.throw $ E.ModuleNotFound origin name srcDirs
80 (_, maybePkgs) ->
81 Task.throw $ E.ModuleAmbiguous origin name paths (maybe [] id maybePkgs)
84elmExists :: Module.Raw -> FilePath -> IO (Maybe FilePath)
85elmExists name srcDir =
86 do let path = srcDir </> Module.nameToSlashPath name <.> "elm"
87 exists <- Dir.doesFileExist path
88 return $ if exists then Just path else Nothing
92-- FIND KERNEL
95findKernel :: FilePath -> Summary.ExposedModules -> E.Origin -> Module.Raw -> Task.Task_ E.Problem Asset
96findKernel srcDir exposed origin name =
97 do let clientPath = srcDir </> Module.nameToSlashPath name <.> "js"
98 let serverPath = srcDir </> Module.nameToSlashPath name <.> "server.js"
99 client <- liftIO $ Dir.doesFileExist clientPath
100 server <- liftIO $ Dir.doesFileExist serverPath
101 if client
102 then return $ Kernel clientPath (if server then Just serverPath else Nothing)
103 else
104 case Map.lookup (N.drop 11 name) exposed of
105 Just [Pkg.Package pkg _vsn] | pkg == Pkg.core || pkg == Pkg.virtualDom ->
106 return ForeignKernel
108 _ ->
109 Task.throw $ E.ModuleNotFound origin name [srcDir]