Skip to content

Commit 8063c4d

Browse files
kritzcreekkritzcreek
committed
[psc-ide] Switches to the Protolude
An alternative Prelude, that is meant to reduce boilerplate and enforce best practices with regards to String
1 parent a07a714 commit 8063c4d

27 files changed

+263
-374
lines changed

‎psc-ide-server/Main.hs‎

Lines changed: 17 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -17,21 +17,14 @@
1717
{-# LANGUAGE OverloadedStrings #-}
1818
{-# LANGUAGE PackageImports #-}
1919
{-# LANGUAGE TemplateHaskell #-}
20+
{-# LANGUAGE NoImplicitPrelude #-}
2021

2122
module Main where
2223

23-
import Prelude ()
24-
import Prelude.Compat
24+
import Protolude
2525

26-
import Control.Concurrent (forkFinally)
2726
import Control.Concurrent.STM
28-
import Control.Exception (bracketOnError, catchJust)
29-
import Control.Monad
30-
import Control.Monad.Error.Class
3127
import "monad-logger" Control.Monad.Logger
32-
import Control.Monad.Reader
33-
import Control.Monad.Trans.Except
34-
import qualified Data.Text as T
3528
import qualified Data.Text.IO as T
3629
import Data.Version (showVersion)
3730
import Language.PureScript.Ide
@@ -43,19 +36,19 @@ import Network hiding (socketPort, accept)
4336
import Network.BSD (getProtocolNumber)
4437
import Network.Socket hiding (PortNumber, Type,
4538
sClose)
46-
import Options.Applicative
39+
import Options.Applicative hiding ((<>))
4740
import System.Directory
4841
import System.FilePath
49-
import System.IO
42+
import System.IO hiding (putStrLn, print)
5043
import System.IO.Error (isEOFError)
5144

5245
import qualified Paths_purescript as Paths
5346

5447
-- "Borrowed" from the Idris Compiler
5548
-- Copied from upstream impl of listenOn
5649
-- bound to localhost interface instead of iNADDR_ANY
57-
listenOnLocalhost :: PortID -> IO Socket
58-
listenOnLocalhost (PortNumber port) = do
50+
listenOnLocalhost :: PortNumber -> IO Socket
51+
listenOnLocalhost port = do
5952
proto <- getProtocolNumber "tcp"
6053
localhost <- inet_addr "127.0.0.1"
6154
bracketOnError
@@ -66,12 +59,11 @@ listenOnLocalhost (PortNumber port) = do
6659
bindSocket sock (SockAddrInet port localhost)
6760
listen sock maxListenQueue
6861
pure sock)
69-
listenOnLocalhost _ = error "Wrong Porttype"
7062

7163
data Options = Options
7264
{ optionsDirectory :: Maybe FilePath
7365
, optionsOutputPath :: FilePath
74-
, optionsPort :: PortID
66+
, optionsPort :: PortNumber
7567
, optionsNoWatch :: Bool
7668
, optionsDebug :: Bool
7769
}
@@ -88,8 +80,8 @@ main = do
8880
unlessM (doesDirectoryExist fullOutputPath) $ do
8981
putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)
9082
createDirectory fullOutputPath
91-
putStrLn "This usually means you didn't compile your project yet."
92-
putStrLn "psc-ide needs you to compile your project (for example by running pulp build)"
83+
putText "This usually means you didn't compile your project yet."
84+
putText "psc-ide needs you to compile your project (for example by running pulp build)"
9385

9486
unless noWatch $
9587
void (forkFinally (watcher ideState fullOutputPath) print)
@@ -100,18 +92,18 @@ main = do
10092
where
10193
parser =
10294
Options
103-
<$> optional (strOption (long "directory" <> short 'd'))
104-
<*> strOption (long "output-directory" <> value "output/")
105-
<*> (PortNumber . fromIntegral <$>
106-
option auto (long "port" <> short 'p' <> value (4242 :: Integer)))
95+
<$> optional (strOption (long "directory" `mappend` short 'd'))
96+
<*> strOption (long "output-directory" `mappend` value "output/")
97+
<*> (fromIntegral <$>
98+
option auto (long "port" `mappend` short 'p' `mappend` value (4242 :: Integer)))
10799
<*> switch (long "no-watch")
108100
<*> switch (long "debug")
109101
opts = info (version <*> helper <*> parser) mempty
110102
version = abortOption
111103
(InfoMsg (showVersion Paths.version))
112-
(long "version" <> help "Show the version number")
104+
(long "version" `mappend` help "Show the version number")
113105

114-
startServer :: PortID -> IdeEnvironment -> IO ()
106+
startServer :: PortNumber -> IdeEnvironment -> IO ()
115107
startServer port env = withSocketsDo $ do
116108
sock <- listenOnLocalhost port
117109
runLogger (runReaderT (forever (loop sock)) env)
@@ -141,8 +133,8 @@ startServer port env = withSocketsDo $ do
141133
liftIO (hClose h)
142134

143135

144-
acceptCommand :: (MonadIO m, MonadLogger m, MonadError T.Text m)
145-
=> Socket -> m (T.Text, Handle)
136+
acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)
137+
=> Socket -> m (Text, Handle)
146138
acceptCommand sock = do
147139
h <- acceptConnection
148140
$(logDebug) "Accepted a connection"

‎purescript.cabal‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,6 @@ library
101101
aeson >= 0.8 && < 0.12,
102102
aeson-better-errors >= 0.8,
103103
ansi-terminal >= 0.6.2 && < 0.7,
104-
async,
105104
base-compat >=0.6.0,
106105
bower-json >= 0.8,
107106
boxes >= 0.1.4 && < 0.2.0,
@@ -126,6 +125,7 @@ library
126125
pipes >= 4.0.0 && < 4.2.0,
127126
pipes-http -any,
128127
process >= 1.2.0 && < 1.5,
128+
protolude >= 0.1.5,
129129
regex-tdfa -any,
130130
safe >= 0.3.9 && < 0.4,
131131
semigroups >= 0.16.2 && < 0.19,
@@ -435,6 +435,7 @@ executable psc-ide-server
435435
mtl -any,
436436
network -any,
437437
optparse-applicative >= 0.12.1,
438+
protolude >= 0.1.5,
438439
stm -any,
439440
text -any,
440441
transformers -any,
@@ -475,6 +476,7 @@ test-suite tests
475476
optparse-applicative -any,
476477
parsec -any,
477478
process -any,
479+
protolude >= 0.1.5,
478480
silently -any,
479481
stm -any,
480482
text -any,

‎src/Language/PureScript/Ide.hs‎

Lines changed: 3 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -21,19 +21,9 @@ module Language.PureScript.Ide
2121
, printModules
2222
) where
2323

24-
import Prelude ()
25-
import Prelude.Compat
24+
import Protolude
2625

27-
import Control.Concurrent.Async
28-
import Control.Monad.Error.Class
29-
import Control.Monad.IO.Class
3026
import "monad-logger" Control.Monad.Logger
31-
import Control.Monad.Reader
32-
import Data.Foldable
33-
import Data.Maybe (catMaybes)
34-
import Data.Monoid
35-
import Data.Text (Text)
36-
import qualified Data.Text as T
3727
import qualified Language.PureScript as P
3828
import qualified Language.PureScript.Ide.CaseSplit as CS
3929
import Language.PureScript.Ide.Command
@@ -50,7 +40,6 @@ import Language.PureScript.Ide.State
5040
import Language.PureScript.Ide.Types
5141
import Language.PureScript.Ide.Util
5242
import System.Directory
53-
import System.Exit
5443
import System.FilePath
5544

5645
handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>
@@ -86,7 +75,7 @@ handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do
8675
handleCommand (Rebuild file) =
8776
rebuildFile file
8877
handleCommand Cwd =
89-
TextResult . T.pack <$> liftIO getCurrentDirectory
78+
TextResult . toS <$> liftIO getCurrentDirectory
9079
handleCommand Reset = resetIdeState *> pure (TextResult "State has been reset.")
9180
handleCommand Quit = liftIO exitSuccess
9281

@@ -127,7 +116,7 @@ listAvailableModules = do
127116
liftIO $ do
128117
contents <- getDirectoryContents oDir
129118
let cleaned = filter (`notElem` [".", ".."]) contents
130-
return (ModuleList (map T.pack cleaned))
119+
return (ModuleList (map toS cleaned))
131120

132121
caseSplit :: (Ide m, MonadError PscIdeError m) =>
133122
Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success

‎src/Language/PureScript/Ide/CaseSplit.hs‎

Lines changed: 14 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -23,14 +23,8 @@ module Language.PureScript.Ide.CaseSplit
2323
, caseSplit
2424
) where
2525

26-
import Prelude ()
27-
import Prelude.Compat hiding (lex)
28-
29-
import Control.Arrow (second)
30-
import Control.Monad.Error.Class
31-
import Data.List (find)
32-
import Data.Monoid
33-
import Data.Text (Text)
26+
import Protolude hiding (Constructor)
27+
3428
import qualified Data.Text as T
3529
import qualified Language.PureScript as P
3630

@@ -56,7 +50,7 @@ noAnnotations = WildcardAnnotations False
5650
caseSplit :: (Ide m, MonadError PscIdeError m) =>
5751
Text -> m [Constructor]
5852
caseSplit q = do
59-
type' <- parseType' (T.unpack q)
53+
type' <- parseType' q
6054
(tc, args) <- splitTypeConstructor type'
6155
(EDType _ _ (P.DataType typeVars ctors)) <- findTypeDeclaration tc
6256
let applyTypeVars = P.everywhereOnTypes (P.replaceAllTypeVars (zip (map fst typeVars) args))
@@ -115,40 +109,39 @@ makePattern t x y wsa = makePattern' (T.take x t) (T.drop y t)
115109

116110
addClause :: (MonadError PscIdeError m) => Text -> WildcardAnnotations -> m [Text]
117111
addClause s wca = do
118-
(fName, fType) <- parseTypeDeclaration' (T.unpack s)
119-
let (args, _) = splitFunctionType fType
112+
(fName, fType) <- parseTypeDeclaration' s
113+
let args = splitFunctionType fType
120114
template = runIdentT fName <> " " <>
121115
T.unwords (map (prettyPrintWildcard wca) args) <>
122116
" = ?" <> (T.strip . runIdentT $ fName)
123117
pure [s, template]
124118

125119
parseType' :: (MonadError PscIdeError m) =>
126-
String -> m P.Type
120+
Text -> m P.Type
127121
parseType' s =
128-
case P.lex "<psc-ide>" s >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of
122+
case P.lex "<psc-ide>" (toS s) >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of
129123
Right type' -> pure type'
130124
Left err ->
131125
throwError (GeneralError ("Parsing the splittype failed with:"
132-
++ show err))
126+
<> show err))
133127

134-
parseTypeDeclaration' :: (MonadError PscIdeError m) => String -> m (P.Ident, P.Type)
128+
parseTypeDeclaration' :: (MonadError PscIdeError m) => Text -> m (P.Ident, P.Type)
135129
parseTypeDeclaration' s =
136130
let x = do
137-
ts <- P.lex "" s
131+
ts <- P.lex "" (toS s)
138132
P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts
139133
in
140134
case unwrapPositioned <$> x of
141135
Right (P.TypeDeclaration i t) -> pure (i, t)
142136
Right _ -> throwError (GeneralError "Found a non-type-declaration")
143137
Left err ->
144138
throwError (GeneralError ("Parsing the typesignature failed with: "
145-
++ show err))
139+
<> show err))
146140

147-
splitFunctionType :: P.Type -> ([P.Type], P.Type)
148-
splitFunctionType t = (arguments, returns)
141+
splitFunctionType :: P.Type -> [P.Type]
142+
splitFunctionType t = fromMaybe [] arguments
149143
where
150-
returns = last splitted
151-
arguments = init splitted
144+
arguments = initMay splitted
152145
splitted = splitType' t
153146
splitType' (P.ForAll _ t' _) = splitType' t'
154147
splitType' (P.ConstrainedType _ t') = splitType' t'

‎src/Language/PureScript/Ide/Command.hs‎

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -16,17 +16,15 @@
1616

1717
module Language.PureScript.Ide.Command where
1818

19-
import Prelude ()
20-
import Prelude.Compat
19+
import Protolude
2120

22-
import Control.Monad
2321
import Data.Aeson
24-
import Data.Text (Text)
2522
import qualified Language.PureScript as P
2623
import Language.PureScript.Ide.CaseSplit
2724
import Language.PureScript.Ide.Filter
2825
import Language.PureScript.Ide.Matcher
2926
import Language.PureScript.Ide.Types
27+
import System.FilePath
3028

3129
data Command
3230
= Load [P.ModuleName]
@@ -70,7 +68,7 @@ data ImportCommand
7068

7169
instance FromJSON ImportCommand where
7270
parseJSON = withObject "ImportCommand" $ \o -> do
73-
(command :: String) <- o .: "importCommand"
71+
(command :: Text) <- o .: "importCommand"
7472
case command of
7573
"addImplicitImport" ->
7674
AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")
@@ -82,7 +80,7 @@ data ListType = LoadedModules | Imports FilePath | AvailableModules
8280

8381
instance FromJSON ListType where
8482
parseJSON = withObject "ListType" $ \o -> do
85-
(listType' :: String) <- o .: "type"
83+
(listType' :: Text) <- o .: "type"
8684
case listType' of
8785
"import" -> Imports <$> o .: "file"
8886
"loadedModules" -> pure LoadedModules
@@ -91,7 +89,7 @@ instance FromJSON ListType where
9189

9290
instance FromJSON Command where
9391
parseJSON = withObject "command" $ \o -> do
94-
(command :: String) <- o .: "command"
92+
(command :: Text) <- o .: "command"
9593
case command of
9694
"list" -> List <$> o .:? "params" .!= LoadedModules
9795
"cwd" -> pure Cwd

‎src/Language/PureScript/Ide/Completion.hs‎

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,11 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
module Language.PureScript.Ide.Completion
3-
(getCompletions, getExactMatches)
4-
where
3+
( getCompletions
4+
, getExactMatches
5+
) where
56

6-
import Prelude ()
7-
import Prelude.Compat
7+
import Protolude
88

9-
import Data.Text (Text)
109
import Language.PureScript.Ide.Filter
1110
import Language.PureScript.Ide.Matcher
1211
import Language.PureScript.Ide.Types
@@ -15,12 +14,11 @@ import Language.PureScript.Ide.Types
1514
-- and sorts the found Completions according to the Matching Score
1615
getCompletions :: [Filter] -> Matcher -> [Module] -> [Match]
1716
getCompletions filters matcher modules =
18-
runMatcher matcher $ completionsFromModules (applyFilters filters modules)
17+
runMatcher matcher (completionsFromModules (applyFilters filters modules))
1918

2019
getExactMatches :: Text -> [Filter] -> [Module] -> [Match]
2120
getExactMatches search filters modules =
22-
completionsFromModules $
23-
applyFilters (equalityFilter search : filters) modules
21+
completionsFromModules (applyFilters (equalityFilter search : filters) modules)
2422

2523
completionsFromModules :: [Module] -> [Match]
2624
completionsFromModules = foldMap completionFromModule

‎src/Language/PureScript/Ide/Conversions.hs‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -14,23 +14,22 @@
1414

1515
module Language.PureScript.Ide.Conversions where
1616

17-
import Prelude.Compat
18-
import Data.Text (Text)
19-
import qualified Data.Text as T
17+
import Protolude
18+
import Data.Text (unwords, lines, strip)
2019
import qualified Language.PureScript as P
2120

2221
runProperNameT :: P.ProperName a -> Text
23-
runProperNameT = T.pack . P.runProperName
22+
runProperNameT = toS . P.runProperName
2423

2524
runIdentT :: P.Ident -> Text
26-
runIdentT = T.pack . P.runIdent
25+
runIdentT = toS . P.runIdent
2726

2827
runOpNameT :: P.OpName a -> Text
29-
runOpNameT = T.pack . P.runOpName
28+
runOpNameT = toS . P.runOpName
3029

3130
runModuleNameT :: P.ModuleName -> Text
32-
runModuleNameT = T.pack . P.runModuleName
31+
runModuleNameT = toS . P.runModuleName
3332

3433
prettyTypeT :: P.Type -> Text
35-
prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType
34+
prettyTypeT = unwords . map strip . lines . toS . P.prettyPrintType
3635

0 commit comments

Comments
 (0)