git.iko.soy/elk
on 0fb8be0 help sign in
elk/builder/src/File/Find.hs
114 lines 3.4 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 Data.Name as Name
13import qualified System.FilePath as FP
14import qualified System.Directory as Dir
15import System.FilePath ((</>), (<.>))
17import qualified Elm.Compiler.Module as Module
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 project srcDirs exposed origin name
50 Project.Pkg _ ->
51 if Name.isKernel 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 project [ toRoot "src" ] exposed origin name
62-- FIND ELM
65findElm :: Project.Project -> [FilePath] -> Summary.ExposedModules -> E.Origin -> Module.Raw -> Task.Task_ E.Problem Asset
66findElm project 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 case project of
79 Project.App _ ->
80 Task.throw $ E.ModuleNotFound origin name (E.App srcDirs)
82 Project.Pkg _ ->
83 Task.throw $ E.ModuleNotFound origin name E.Pkg
85 (_, maybePkgs) ->
86 Task.throw $ E.ModuleAmbiguous origin name paths (maybe [] id maybePkgs)
89elmExists :: Module.Raw -> FilePath -> IO (Maybe FilePath)
90elmExists name srcDir =
91 do let path = srcDir </> Module.nameToSlashPath name <.> "elm"
92 exists <- Dir.doesFileExist path
93 return $ if exists then Just path else Nothing
97-- FIND KERNEL
100findKernel :: FilePath -> Summary.ExposedModules -> E.Origin -> Module.Raw -> Task.Task_ E.Problem Asset
101findKernel srcDir exposed origin name =
102 do let clientPath = srcDir </> Module.nameToSlashPath name <.> "js"
103 let serverPath = srcDir </> Module.nameToSlashPath name <.> "server.js"
104 client <- liftIO $ Dir.doesFileExist clientPath
105 server <- liftIO $ Dir.doesFileExist serverPath
106 if client
107 then return $ Kernel clientPath (if server then Just serverPath else Nothing)
108 else
109 case Map.lookup (Name.getKernel name) exposed of
110 Just [Pkg.Package pkg _vsn] | pkg == Pkg.core || pkg == Pkg.virtualDom ->
111 return ForeignKernel
113 _ ->
114 Task.throw $ E.ModuleNotFound origin name E.Pkg