Skip to content
This repository has been archived by the owner on Aug 23, 2018. It is now read-only.

Commit

Permalink
Switch from String to Text, following changes in elm-compiler
Browse files Browse the repository at this point in the history
  • Loading branch information
evancz committed Dec 16, 2016
1 parent 26f458f commit 2cf040a
Show file tree
Hide file tree
Showing 6 changed files with 39 additions and 29 deletions.
3 changes: 2 additions & 1 deletion src/BuildManager.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.State (StateT, liftIO, runStateT)
import qualified Control.Monad.State as State
import qualified Data.List as List
import Data.Text (Text)
import qualified Data.Time.Clock.POSIX as Time
import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module
Expand Down Expand Up @@ -138,7 +139,7 @@ phaseToString overallDuration indent (Phase tag start subphases end) =


data Error
= CompilerErrors FilePath String [Compiler.Error]
= CompilerErrors FilePath Text [Compiler.Error]
| CorruptedArtifact FilePath
| Cycle [TMP.CanonicalModule]
| PackageProblem String
Expand Down
9 changes: 6 additions & 3 deletions src/Pipeline/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,8 @@ import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy.IO as LazyTextIO
import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module
Expand Down Expand Up @@ -253,7 +255,7 @@ buildModule env interfaces (modul, location) =
context =
Compiler.Context packageName isExposed deps
in
do source <- readFile path
do source <- Text.readFile path

let (localizer, warnings, rawResult) =
Compiler.compile context source ifaces
Expand All @@ -264,8 +266,9 @@ buildModule env interfaces (modul, location) =
Chan.writeChan (resultChan env) result


data Result = Result
{ _source :: String
data Result =
Result
{ _source :: Text.Text
, _path :: FilePath
, _moduleID :: CanonicalModule
, _localizer :: Compiler.Localizer
Expand Down
18 changes: 9 additions & 9 deletions src/Pipeline/Crawl/Package.hs
Original file line number Diff line number Diff line change
@@ -1,9 +1,11 @@
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
module Pipeline.Crawl.Package where

import Control.Arrow (second)
import Control.Monad.Except (liftIO, throwError)
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module
import qualified Elm.Package.Description as Desc
Expand Down Expand Up @@ -185,12 +187,10 @@ findHelp allowNatives locations moduleName (dir:srcDirs) =
addJsPath locs =
do let jsPath = dir </> Module.nameToPath moduleName <.> "js"
jsExists <-
case moduleName of
"Native" : _ ->
liftIO (doesFileExist jsPath)

_ ->
return False
if Text.isPrefixOf "Native." moduleName then
liftIO (doesFileExist jsPath)
else
return False

return (consIf jsExists (JS jsPath) locs)

Expand All @@ -205,15 +205,15 @@ readPackageData
-> FilePath
-> BM.Task (Module.Raw, (PackageData, [Unvisited]))
readPackageData env maybeName filePath =
do sourceCode <- liftIO (File.readStringUtf8 filePath)
do sourceCode <- liftIO (File.readTextUtf8 filePath)

(tag, name, deps) <-
case Compiler.parseDependencies (_packageName env) sourceCode of
Right result ->
return result

Left msgs ->
throwError (BM.CompilerErrors filePath sourceCode msgs)
Left msg ->
throwError (BM.CompilerErrors filePath sourceCode [msg])

checkName filePath name maybeName
checkTag filePath name (_permissions env) tag
Expand Down
13 changes: 8 additions & 5 deletions src/Pipeline/Generate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -142,7 +142,7 @@ getReachableObjectFiles debug moduleNames allNodes =

isVirtualDomDebug :: (fp, TMP.CanonicalModule, deps) -> Bool
isVirtualDomDebug (_filePath, TMP.CanonicalModule (pkg, _vsn) name, _deps) =
pkg == Pkg.virtualDom && name == ["VirtualDom","Debug"]
pkg == Pkg.virtualDom && name == "VirtualDom.Debug"



Expand Down Expand Up @@ -196,16 +196,19 @@ exportProgram
-> Map.Map Module.Canonical Module.Interface
-> Module.Canonical
-> String
exportProgram debugMode interfaces canonicalName@(Module.Canonical _ moduleName) =
exportProgram debugMode interfaces canonicalName@(Module.Canonical _ rawName) =
let
program =
Module.qualifiedVar canonicalName "main"
Text.unpack (Module.qualifiedVar canonicalName "main")

moduleName =
map Text.unpack (Text.splitOn "." rawName)

object =
objectFor moduleName

name =
Module.nameToString moduleName
Module.nameToString rawName

debugArg =
if debugMode then createDebugMetadata interfaces canonicalName else "undefined"
Expand Down Expand Up @@ -246,7 +249,7 @@ setup moduleName =
unlines (map create paths)


objectFor :: Module.Raw -> String
objectFor :: [String] -> String
objectFor names =
let
brackets :: String -> String
Expand Down
15 changes: 8 additions & 7 deletions src/Pipeline/Plan.hs
Original file line number Diff line number Diff line change
@@ -1,9 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module Pipeline.Plan where

import Control.Monad (foldM)
import Control.Monad.Except (liftIO, throwError)
import qualified Data.Graph as Graph
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Time.Clock (UTCTime)
import Data.Map ((!))
import qualified Data.Map as Map
Expand Down Expand Up @@ -81,7 +83,7 @@ getFreshInterfaceInfo sourcePath interfacePath =

isMain :: CanonicalModule -> Bool
isMain (CanonicalModule _ names) =
names == ["Main"]
names == "Main"



Expand Down Expand Up @@ -192,13 +194,12 @@ filterCachedDeps interfaces name =


filterNativeDeps :: CanonicalModule -> Maybe CanonicalModule
filterNativeDeps name =
case name of
CanonicalModule _pkg ("Native" : _) ->
Nothing
filterNativeDeps moduleName@(CanonicalModule _ name) =
if Text.isPrefixOf "Native." name then
Nothing

_ ->
Just name
else
Just moduleName



Expand Down
10 changes: 6 additions & 4 deletions src/Report.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@ import qualified Control.Concurrent.Chan as Chan
import Control.Monad (when)
import qualified Data.Aeson as Json
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Elm.Compiler as Compiler
import qualified Elm.Package as Pkg
import qualified Elm.Package.Paths as Path
Expand All @@ -20,8 +22,8 @@ data Type = Normal | Json

data Message
= Close
| Complete CanonicalModule Compiler.Localizer FilePath String [Compiler.Warning]
| Error CanonicalModule Compiler.Localizer FilePath String [Compiler.Warning] [Compiler.Error]
| Complete CanonicalModule Compiler.Localizer FilePath Text [Compiler.Warning]
| Error CanonicalModule Compiler.Localizer FilePath Text [Compiler.Warning] [Compiler.Error]



Expand Down Expand Up @@ -157,15 +159,15 @@ printSeparator isTerminal color header =
when isTerminal $ hSetSGR stderr [Reset]


printError :: Bool -> Compiler.Localizer -> FilePath -> String -> Compiler.Error -> IO ()
printError :: Bool -> Compiler.Localizer -> FilePath -> Text -> Compiler.Error -> IO ()
printError isTerminal localizer path source err =
if isTerminal then
Compiler.printError stderr localizer path source err
else
hPutStr stderr (Compiler.errorToString localizer path source err)


printWarning :: Bool -> Compiler.Localizer -> FilePath -> String -> Compiler.Warning -> IO ()
printWarning :: Bool -> Compiler.Localizer -> FilePath -> Text -> Compiler.Warning -> IO ()
printWarning isTerminal localizer path source err =
if isTerminal then
Compiler.printWarning stderr localizer path source err
Expand Down

0 comments on commit 2cf040a

Please sign in to comment.