git.iko.soy/elk
on e2aff93 help sign in
elk/compiler/Build/File.hs
105 lines 3.9 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Build.File (build) where
4import Control.Monad (when)
5import qualified Data.Binary as Binary
6import qualified Data.Map as Map
7import System.Directory
8import System.Exit
9import System.FilePath
10import System.IO
12import qualified Transform.Canonicalize as Canonical
14import qualified Data.ByteString.Lazy as L
16import qualified Build.Utils as Utils
17import qualified Build.Flags as Flag
18import qualified Build.Interface as Interface
19import qualified Build.Print as Print
20import qualified Build.Source as Source
21import qualified Generate.JavaScript as JS
22import qualified Parse.Module as Parser
23import qualified SourceSyntax.Module as M
25build :: Flag.Flags -> Int -> M.Interfaces -> String -> [FilePath]
26 -> IO (String, M.Interfaces)
27build _ _ interfaces moduleName [] =
28 return (moduleName, interfaces)
29build flags numModules interfaces _ (filePath:rest) =
30 do (name,interface) <-
31 build1 flags (numModules - length rest) numModules interfaces filePath
32 let interfaces' = Map.insert name interface interfaces
33 build flags numModules interfaces' name rest
36build1 :: Flag.Flags -> Int -> Int -> M.Interfaces -> FilePath
37 -> IO (String, M.ModuleInterface)
38build1 flags moduleNum numModules interfaces filePath =
39 do compiled <- alreadyCompiled flags filePath
40 case compiled of
41 False -> compile flags number interfaces filePath
42 True -> retrieve flags interfaces filePath
43 where
44 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
47alreadyCompiled :: Flag.Flags -> FilePath -> IO Bool
48alreadyCompiled flags filePath = do
49 existsi <- doesFileExist (Utils.elmi flags filePath)
50 existso <- doesFileExist (Utils.elmo flags filePath)
51 if not existsi || not existso
52 then return False
53 else do tsrc <- getModificationTime filePath
54 tint <- getModificationTime (Utils.elmo flags filePath)
55 return (tsrc <= tint)
57retrieve :: Flag.Flags -> Map.Map String M.ModuleInterface -> FilePath
58 -> IO (String, M.ModuleInterface)
59retrieve flags interfaces filePath = do
60 iface <- Interface.load (Utils.elmi flags filePath)
61 case Interface.isValid filePath iface of
62 Right (name, interface) ->
63 do when (Flag.print_types flags) (Print.interfaceTypes interfaces interface)
64 return (name, interface)
65 Left err ->
66 do hPutStrLn stderr err
67 exitFailure
69compile :: Flag.Flags -> String -> M.Interfaces -> FilePath
70 -> IO (String, M.ModuleInterface)
71compile flags number interfaces filePath =
72 do source <- readFile filePath
73 let name = getName source
74 printStatus name
76 createDirectoryIfMissing True (Flag.cache_dir flags)
77 createDirectoryIfMissing True (Flag.build_dir flags)
79 metaModule <-
80 case Source.build (Flag.no_prelude flags) interfaces source of
81 Right modul -> return modul
82 Left errors -> do Print.errors errors
83 exitFailure
85 when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule
87 let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule)
88 generateCache intermediate metaModule
89 return intermediate
91 where
92 getName source = case Parser.getModuleName source of
93 Just n -> n
94 Nothing -> "Main"
96 printStatus name =
97 hPutStrLn stdout $ concat [ number, " Compiling ", name
98 , replicate (max 1 (20 - length name)) ' '
99 , "( " ++ filePath ++ " )" ]
101 generateCache intermediate metaModule = do
102 createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
103 writeFile (Utils.elmo flags filePath) (JS.generate metaModule)
104 withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
105 L.hPut handle (Binary.encode intermediate)