[psc-ide] Switches to the Protolude

An alternative Prelude, that is meant to reduce boilerplate and enforce best practices with regards to String
purescript · Jun 26, 2016 · 8063c4d · 8063c4d
1 parent a07a714
commit 8063c4d
Show file tree

Hide file tree

Showing 27 changed files with 263 additions and 374 deletions.
diff --git a/psc-ide-server/Main.hs b/psc-ide-server/Main.hs
@@ -17,21 +17,14 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PackageImports        #-}
 {-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
 
 module Main where
 
-import           Prelude                           ()
-import           Prelude.Compat
+import           Protolude
 
-import           Control.Concurrent                (forkFinally)
 import           Control.Concurrent.STM
-import           Control.Exception                 (bracketOnError, catchJust)
-import           Control.Monad
-import           Control.Monad.Error.Class
 import           "monad-logger" Control.Monad.Logger
-import           Control.Monad.Reader
-import           Control.Monad.Trans.Except
-import qualified Data.Text                         as T
 import qualified Data.Text.IO                      as T
 import           Data.Version                      (showVersion)
 import           Language.PureScript.Ide
@@ -43,19 +36,19 @@ import           Network                           hiding (socketPort, accept)
 import           Network.BSD                       (getProtocolNumber)
 import           Network.Socket                    hiding (PortNumber, Type,
                                                     sClose)
-import           Options.Applicative
+import           Options.Applicative               hiding ((<>))
 import           System.Directory
 import           System.FilePath
-import           System.IO
+import           System.IO                         hiding (putStrLn, print)
 import           System.IO.Error                   (isEOFError)
 
 import qualified Paths_purescript                  as Paths
 
 -- "Borrowed" from the Idris Compiler
 -- Copied from upstream impl of listenOn
 -- bound to localhost interface instead of iNADDR_ANY
-listenOnLocalhost :: PortID -> IO Socket
-listenOnLocalhost (PortNumber port) = do
+listenOnLocalhost :: PortNumber -> IO Socket
+listenOnLocalhost port = do
   proto <- getProtocolNumber "tcp"
   localhost <- inet_addr "127.0.0.1"
   bracketOnError
@@ -66,12 +59,11 @@ listenOnLocalhost (PortNumber port) = do
       bindSocket sock (SockAddrInet port localhost)
       listen sock maxListenQueue
       pure sock)
-listenOnLocalhost _ = error "Wrong Porttype"
 
 data Options = Options
   { optionsDirectory  :: Maybe FilePath
   , optionsOutputPath :: FilePath
-  , optionsPort       :: PortID
+  , optionsPort       :: PortNumber
   , optionsNoWatch    :: Bool
   , optionsDebug      :: Bool
   }
@@ -88,8 +80,8 @@ main = do
   unlessM (doesDirectoryExist fullOutputPath) $ do
     putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)
     createDirectory fullOutputPath
-    putStrLn "This usually means you didn't compile your project yet."
-    putStrLn "psc-ide needs you to compile your project (for example by running pulp build)"
+    putText "This usually means you didn't compile your project yet."
+    putText "psc-ide needs you to compile your project (for example by running pulp build)"
 
   unless noWatch $
     void (forkFinally (watcher ideState fullOutputPath) print)
@@ -100,18 +92,18 @@ main = do
   where
     parser =
       Options
-        <$> optional (strOption (long "directory" <> short 'd'))
-        <*> strOption (long "output-directory" <> value "output/")
-        <*> (PortNumber . fromIntegral <$>
-             option auto (long "port" <> short 'p' <> value (4242 :: Integer)))
+        <$> optional (strOption (long "directory" `mappend` short 'd'))
+        <*> strOption (long "output-directory" `mappend` value "output/")
+        <*> (fromIntegral <$>
+             option auto (long "port" `mappend` short 'p' `mappend` value (4242 :: Integer)))
         <*> switch (long "no-watch")
         <*> switch (long "debug")
     opts = info (version <*> helper <*> parser) mempty
     version = abortOption
       (InfoMsg (showVersion Paths.version))
-      (long "version" <> help "Show the version number")
+      (long "version" `mappend` help "Show the version number")
 
-startServer :: PortID -> IdeEnvironment -> IO ()
+startServer :: PortNumber -> IdeEnvironment -> IO ()
 startServer port env = withSocketsDo $ do
   sock <- listenOnLocalhost port
   runLogger (runReaderT (forever (loop sock)) env)
@@ -141,8 +133,8 @@ startServer port env = withSocketsDo $ do
           liftIO (hClose h)
 
 
-acceptCommand :: (MonadIO m, MonadLogger m, MonadError T.Text m)
-                 => Socket -> m (T.Text, Handle)
+acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)
+                 => Socket -> m (Text, Handle)
 acceptCommand sock = do
   h <- acceptConnection
   $(logDebug) "Accepted a connection"

diff --git a/purescript.cabal b/purescript.cabal
@@ -101,7 +101,6 @@ library
                    aeson >= 0.8 && < 0.12,
                    aeson-better-errors >= 0.8,
                    ansi-terminal >= 0.6.2 && < 0.7,
-                   async,
                    base-compat >=0.6.0,
                    bower-json >= 0.8,
                    boxes >= 0.1.4 && < 0.2.0,
@@ -126,6 +125,7 @@ library
                    pipes >= 4.0.0 && < 4.2.0,
                    pipes-http -any,
                    process >= 1.2.0 && < 1.5,
+                   protolude >= 0.1.5,
                    regex-tdfa -any,
                    safe >= 0.3.9 && < 0.4,
                    semigroups >= 0.16.2 && < 0.19,
@@ -435,6 +435,7 @@ executable psc-ide-server
                        mtl -any,
                        network -any,
                        optparse-applicative >= 0.12.1,
+                       protolude >= 0.1.5,
                        stm -any,
                        text -any,
                        transformers -any,
@@ -475,6 +476,7 @@ test-suite tests
                    optparse-applicative -any,
                    parsec -any,
                    process -any,
+                   protolude >= 0.1.5,
                    silently -any,
                    stm -any,
                    text -any,

diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs
@@ -21,19 +21,9 @@ module Language.PureScript.Ide
        , printModules
        ) where
 
-import           Prelude                            ()
-import           Prelude.Compat
+import           Protolude
 
-import           Control.Concurrent.Async
-import           Control.Monad.Error.Class
-import           Control.Monad.IO.Class
 import           "monad-logger" Control.Monad.Logger
-import           Control.Monad.Reader
-import           Data.Foldable
-import           Data.Maybe                         (catMaybes)
-import           Data.Monoid
-import           Data.Text                          (Text)
-import qualified Data.Text                          as T
 import qualified Language.PureScript                as P
 import qualified Language.PureScript.Ide.CaseSplit  as CS
 import           Language.PureScript.Ide.Command
@@ -50,7 +40,6 @@ import           Language.PureScript.Ide.State
 import           Language.PureScript.Ide.Types
 import           Language.PureScript.Ide.Util
 import           System.Directory
-import           System.Exit
 import           System.FilePath
 
 handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>
@@ -86,7 +75,7 @@ handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do
 handleCommand (Rebuild file) =
   rebuildFile file
 handleCommand Cwd =
-  TextResult . T.pack <$> liftIO getCurrentDirectory
+  TextResult . toS <$> liftIO getCurrentDirectory
 handleCommand Reset = resetIdeState *> pure (TextResult "State has been reset.")
 handleCommand Quit = liftIO exitSuccess
 
@@ -127,7 +116,7 @@ listAvailableModules = do
   liftIO $ do
     contents <- getDirectoryContents oDir
     let cleaned = filter (`notElem` [".", ".."]) contents
-    return (ModuleList (map T.pack cleaned))
+    return (ModuleList (map toS cleaned))
 
 caseSplit :: (Ide m, MonadError PscIdeError m) =>
   Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success

diff --git a/src/Language/PureScript/Ide/CaseSplit.hs b/src/Language/PureScript/Ide/CaseSplit.hs
@@ -23,14 +23,8 @@ module Language.PureScript.Ide.CaseSplit
        , caseSplit
        ) where
 
-import           Prelude                                 ()
-import           Prelude.Compat                          hiding (lex)
-
-import           Control.Arrow                           (second)
-import           Control.Monad.Error.Class
-import           Data.List                               (find)
-import           Data.Monoid
-import           Data.Text                               (Text)
+import           Protolude hiding (Constructor)
+
 import qualified Data.Text                               as T
 import qualified Language.PureScript                     as P
 
@@ -56,7 +50,7 @@ noAnnotations = WildcardAnnotations False
 caseSplit :: (Ide m, MonadError PscIdeError m) =>
              Text -> m [Constructor]
 caseSplit q = do
-  type' <- parseType' (T.unpack q)
+  type' <- parseType' q
   (tc, args) <- splitTypeConstructor type'
   (EDType _ _ (P.DataType typeVars ctors)) <- findTypeDeclaration tc
   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)
 
 addClause :: (MonadError PscIdeError m) => Text -> WildcardAnnotations -> m [Text]
 addClause s wca = do
-  (fName, fType) <- parseTypeDeclaration' (T.unpack s)
-  let (args, _) = splitFunctionType fType
+  (fName, fType) <- parseTypeDeclaration' s
+  let args = splitFunctionType fType
       template = runIdentT fName <> " " <>
         T.unwords (map (prettyPrintWildcard wca) args) <>
         " = ?" <> (T.strip . runIdentT $ fName)
   pure [s, template]
 
 parseType' :: (MonadError PscIdeError m) =>
-              String -> m P.Type
+              Text -> m P.Type
 parseType' s =
-  case P.lex "<psc-ide>" s >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of
+  case P.lex "<psc-ide>" (toS s) >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of
     Right type' -> pure type'
     Left err ->
       throwError (GeneralError ("Parsing the splittype failed with:"
-                                ++ show err))
+                                <> show err))
 
-parseTypeDeclaration' :: (MonadError PscIdeError m) => String -> m (P.Ident, P.Type)
+parseTypeDeclaration' :: (MonadError PscIdeError m) => Text -> m (P.Ident, P.Type)
 parseTypeDeclaration' s =
   let x = do
-        ts <- P.lex "" s
+        ts <- P.lex "" (toS s)
         P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts
   in
     case unwrapPositioned <$> x of
       Right (P.TypeDeclaration i t) -> pure (i, t)
       Right _ -> throwError (GeneralError "Found a non-type-declaration")
       Left err ->
         throwError (GeneralError ("Parsing the typesignature failed with: "
-                                ++ show err))
+                                  <> show err))
 
-splitFunctionType :: P.Type -> ([P.Type], P.Type)
-splitFunctionType t = (arguments, returns)
+splitFunctionType :: P.Type -> [P.Type]
+splitFunctionType t = fromMaybe [] arguments
   where
-    returns = last splitted
-    arguments = init splitted
+    arguments = initMay splitted
     splitted = splitType' t
     splitType' (P.ForAll _ t' _) = splitType' t'
     splitType' (P.ConstrainedType _ t') = splitType' t'

diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs
@@ -16,17 +16,15 @@
 
 module Language.PureScript.Ide.Command where
 
-import           Prelude                           ()
-import           Prelude.Compat
+import           Protolude
 
-import           Control.Monad
 import           Data.Aeson
-import           Data.Text                         (Text)
 import qualified Language.PureScript               as P
 import           Language.PureScript.Ide.CaseSplit
 import           Language.PureScript.Ide.Filter
 import           Language.PureScript.Ide.Matcher
 import           Language.PureScript.Ide.Types
+import           System.FilePath
 
 data Command
     = Load [P.ModuleName]
@@ -70,7 +68,7 @@ data ImportCommand
 
 instance FromJSON ImportCommand where
   parseJSON = withObject "ImportCommand" $ \o -> do
-    (command :: String) <- o .: "importCommand"
+    (command :: Text) <- o .: "importCommand"
     case command of
       "addImplicitImport" ->
         AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")
@@ -82,7 +80,7 @@ data ListType = LoadedModules | Imports FilePath | AvailableModules
 
 instance FromJSON ListType where
   parseJSON = withObject "ListType" $ \o -> do
-    (listType' :: String) <- o .: "type"
+    (listType' :: Text) <- o .: "type"
     case listType' of
       "import" -> Imports <$> o .: "file"
       "loadedModules" -> pure LoadedModules
@@ -91,7 +89,7 @@ instance FromJSON ListType where
 
 instance FromJSON Command where
   parseJSON = withObject "command" $ \o -> do
-    (command :: String) <- o .: "command"
+    (command :: Text) <- o .: "command"
     case command of
       "list" -> List <$> o .:? "params" .!= LoadedModules
       "cwd"  -> pure Cwd

diff --git a/src/Language/PureScript/Ide/Completion.hs b/src/Language/PureScript/Ide/Completion.hs
@@ -1,12 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.PureScript.Ide.Completion
-       (getCompletions, getExactMatches)
-       where
+       ( getCompletions
+       , getExactMatches
+       ) where
 
-import           Prelude                         ()
-import           Prelude.Compat
+import           Protolude
 
-import           Data.Text                       (Text)
 import           Language.PureScript.Ide.Filter
 import           Language.PureScript.Ide.Matcher
 import           Language.PureScript.Ide.Types
@@ -15,12 +14,11 @@ import           Language.PureScript.Ide.Types
 --   and sorts the found Completions according to the Matching Score
 getCompletions :: [Filter] -> Matcher -> [Module] -> [Match]
 getCompletions filters matcher modules =
-    runMatcher matcher $ completionsFromModules (applyFilters filters modules)
+  runMatcher matcher (completionsFromModules (applyFilters filters modules))
 
 getExactMatches :: Text -> [Filter] -> [Module] -> [Match]
 getExactMatches search filters modules =
-    completionsFromModules $
-    applyFilters (equalityFilter search : filters) modules
+  completionsFromModules (applyFilters (equalityFilter search : filters) modules)
 
 completionsFromModules :: [Module] -> [Match]
 completionsFromModules = foldMap completionFromModule

diff --git a/src/Language/PureScript/Ide/Conversions.hs b/src/Language/PureScript/Ide/Conversions.hs
@@ -14,23 +14,22 @@
 
 module Language.PureScript.Ide.Conversions where
 
-import           Prelude.Compat
-import           Data.Text           (Text)
-import qualified Data.Text           as T
+import           Protolude
+import           Data.Text           (unwords, lines, strip)
 import qualified Language.PureScript as P
 
 runProperNameT :: P.ProperName a -> Text
-runProperNameT = T.pack . P.runProperName
+runProperNameT = toS . P.runProperName
 
 runIdentT :: P.Ident -> Text
-runIdentT = T.pack . P.runIdent
+runIdentT = toS . P.runIdent
 
 runOpNameT :: P.OpName a -> Text
-runOpNameT = T.pack . P.runOpName
+runOpNameT = toS . P.runOpName
 
 runModuleNameT :: P.ModuleName -> Text
-runModuleNameT = T.pack . P.runModuleName
+runModuleNameT = toS . P.runModuleName
 
 prettyTypeT :: P.Type -> Text
-prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType
+prettyTypeT = unwords . map strip . lines . toS . P.prettyPrintType