git.iko.soy/elk
on 6ae0168 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 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 project 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 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 (N.drop 11 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