11{-# LANGUAGE DataKinds #-}
2- {-# LANGUAGE DeriveAnyClass #-}
32{-# LANGUAGE DeriveGeneric #-}
43{-# LANGUAGE LambdaCase #-}
54{-# LANGUAGE OverloadedStrings #-}
6- {-# LANGUAGE TupleSections #-}
75
86module Main (main ) where
97
10- import Control.Monad (unless , (>=>) , foldM )
8+ import Control.Monad (unless , foldM )
119import Control.Monad.Error.Class (throwError )
12- import Control.Monad.IO.Class (liftIO )
1310import Control.Monad.Logger (runLogger' )
14- import Control.Monad.State (State )
1511import qualified Control.Monad.State as State
1612import Control.Monad.Trans (lift )
1713import Control.Monad.Trans.Except (ExceptT (.. ), runExceptT )
@@ -23,15 +19,12 @@ import Data.Bifunctor (first, second)
2319import qualified Data.ByteString.Lazy as BL
2420import Data.Default (def )
2521import Data.Function (on )
26- import Data.List (foldl' , nubBy )
22+ import Data.List (nubBy )
2723import qualified Data.List.NonEmpty as NE
2824import qualified Data.Map as M
29- import Data.String (fromString )
3025import Data.Text (Text )
3126import qualified Data.Text as T
3227import qualified Data.Text.Encoding as T
33- import qualified Data.Text.Lazy as TL
34- import Data.Traversable (for )
3528import GHC.Generics (Generic )
3629import qualified Language.PureScript as P
3730import qualified Language.PureScript.CST as CST
@@ -45,10 +38,7 @@ import qualified Language.PureScript.TypeChecker.TypeSearch as TS
4538import qualified Network.Wai.Handler.Warp as Warp
4639import System.Environment (getArgs )
4740import System.Exit (exitFailure )
48- import System.FilePath ((</>) )
4941import System.FilePath.Glob (glob )
50- import qualified System.IO as IO
51- import System.IO.UTF8 (readUTF8File )
5242import Web.Scotty
5343import qualified Web.Scotty as Scotty
5444
@@ -67,7 +57,6 @@ server externs initNamesEnv initEnv port = do
6757 compile input
6858 | T. length input > 20000 = return (Left (OtherError " Please limit your input to 20000 characters" ))
6959 | otherwise = do
70- let printErrors = P. prettyPrintMultipleErrors (P. defaultPPEOptions { P. ppeCodeColor = Nothing })
7160 case CST. parseModuleFromFile " <file>" input >>= CST. resFull of
7261 Left parseError ->
7362 return . Left . CompilerErrors . P. toJSONErrors False P. Error $ CST. toMultipleErrors " <file>" parseError
@@ -137,7 +126,7 @@ lookupAllConstructors env = P.everywhereOnTypesM $ \case
137126 lookupConstructor :: P. Environment -> P. ProperName 'P.TypeName -> [P. Qualified (P. ProperName 'P.TypeName )]
138127 lookupConstructor env nm =
139128 [ q
140- | (q@ (P. Qualified (Just mn ) thisNm), _) <- M. toList (P. types env)
129+ | (q@ (P. Qualified (Just _ ) thisNm), _) <- M. toList (P. types env)
141130 , thisNm == nm
142131 ]
143132
@@ -165,7 +154,7 @@ tryParseType = hush . fmap (CST.convertType "<file>") . runParser CST.parseTypeP
165154
166155 runParser :: CST. Parser a -> Text -> Either String a
167156 runParser p =
168- first (CST. prettyPrintError . NE. head )
157+ first (CST. prettyPrintError . NE. head )
169158 . CST. runTokenParser (p <* CSTM. token CST. TokEof )
170159 . CST. lexTopLevel
171160
@@ -174,7 +163,6 @@ main = do
174163 (portString : inputGlobs) <- getArgs
175164 let port = read portString
176165 inputFiles <- concat <$> traverse glob inputGlobs
177- let onError f = either (Left . f) Right
178166 e <- runExceptT $ do
179167 modules <- ExceptT $ I. loadAllModules inputFiles
180168 (exts, env) <- ExceptT . I. runMake . I. make $ map (second CST. pureResult) modules
0 commit comments