From 195c8174c97a61abebb32caff5424c44cd92f622 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 10 Oct 2017 11:43:10 -0700 Subject: [PATCH 1/3] Gracefully close stat client socket --- src/Semantic/Stat.hs | 7 ++++++- src/Semantic/Task.hs | 1 + 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Semantic/Stat.hs b/src/Semantic/Stat.hs index 9bb500906..c1a8e5c49 100644 --- a/src/Semantic/Stat.hs +++ b/src/Semantic/Stat.hs @@ -14,6 +14,7 @@ module Semantic.Stat -- Client , defaultStatsClient , StatsClient(..) +, closeStatClient -- Internal, exposed for testing , renderDatagram @@ -26,7 +27,7 @@ import Data.List (intercalate) import Data.List.Split (splitOneOf) import Data.Maybe import Data.Monoid -import Network.Socket (Socket(..), SocketType(..), socket, connect, getAddrInfo, addrFamily, addrAddress, defaultProtocol) +import Network.Socket (Socket(..), SocketType(..), socket, connect, close, getAddrInfo, addrFamily, addrAddress, defaultProtocol) import Network.Socket.ByteString import Network.URI import Numeric @@ -138,6 +139,10 @@ statsClient host port statsClientNamespace = do connect sock (addrAddress addr) pure (StatsClient sock statsClientNamespace host port) +-- | Close the client's underlying socket. +closeStatClient :: StatsClient -> IO () +closeStatClient StatsClient{..} = close statsClientUDPSocket + -- | Send a stat over the StatsClient's socket. sendStat :: StatsClient -> Stat -> IO () sendStat StatsClient{..} = void . tryIOError . sendAll statsClientUDPSocket . B.pack . renderDatagram statsClientNamespace diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 5100b56d7..785ed8e0d 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -162,6 +162,7 @@ runTaskWithOptions options task = do run options logger statter task closeQueue statter + closeStatClient (asyncQueueExtra statter) closeQueue logger either (die . displayException) pure result where From d274004231f36c0ca662b03519108b282aa415da Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 10 Oct 2017 12:15:09 -0700 Subject: [PATCH 2/3] Update instances to include Ord1 --- src/Data/Syntax/Comment.hs | 2 ++ src/Data/Syntax/Literal.hs | 3 ++ src/Data/Syntax/Statement.hs | 67 ++++++++++++++++++++++++------------ 3 files changed, 50 insertions(+), 22 deletions(-) diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index f2582ccb8..0e1d7aeec 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -5,6 +5,7 @@ import Algorithm import Data.Align.Generic import Data.ByteString (ByteString) import Data.Functor.Classes.Eq.Generic +import Data.Functor.Classes.Ord.Generic import Data.Functor.Classes.Show.Generic import Data.Mergeable import GHC.Generics @@ -14,6 +15,7 @@ newtype Comment a = Comment { commentContent :: ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) instance Eq1 Comment where liftEq = genericLiftEq +instance Ord1 Comment where liftCompare = genericLiftCompare instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec -- TODO: nested comment types diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 95b15c666..bcd11eb06 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -46,6 +46,7 @@ newtype Float a = Float { floatContent :: ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq +instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsPrec -- Rational literals e.g. `2/3r` @@ -104,6 +105,7 @@ newtype Symbol a = Symbol { symbolContent :: ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Symbol where liftEq = genericLiftEq +instance Ord1 Symbol where liftCompare = genericLiftCompare instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec newtype Regex a = Regex { regexContent :: ByteString } @@ -138,6 +140,7 @@ data KeyValue a = KeyValue { key :: !a, value :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 KeyValue where liftEq = genericLiftEq +instance Ord1 KeyValue where liftCompare = genericLiftCompare instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 721b053fa..4de906ecf 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -4,45 +4,51 @@ module Data.Syntax.Statement where import Algorithm import Data.Align.Generic import Data.Functor.Classes.Eq.Generic +import Data.Functor.Classes.Ord.Generic import Data.Functor.Classes.Show.Generic import Data.Mergeable import GHC.Generics -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted. data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 If where liftEq = genericLiftEq +instance Ord1 If where liftCompare = genericLiftCompare instance Show1 If where liftShowsPrec = genericLiftShowsPrec -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python. data Else a = Else { elseCondition :: !a, elseBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Else where liftEq = genericLiftEq +instance Ord1 Else where liftCompare = genericLiftCompare instance Show1 Else where liftShowsPrec = genericLiftShowsPrec -- TODO: Alternative definition would flatten if/else if/else chains: data If a = If ![(a, a)] !(Maybe a) -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell. data Match a = Match { matchSubject :: !a, matchPatterns :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Match where liftEq = genericLiftEq +instance Ord1 Match where liftCompare = genericLiftCompare instance Show1 Match where liftShowsPrec = genericLiftShowsPrec -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions. data Pattern a = Pattern { pattern :: !a, patternBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Pattern where liftEq = genericLiftEq +instance Ord1 Pattern where liftCompare = genericLiftCompare instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec -- | A let statement or local binding, like 'a as b' or 'let a = b'. data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Let where liftEq = genericLiftEq +instance Ord1 Let where liftCompare = genericLiftCompare instance Show1 Let where liftShowsPrec = genericLiftShowsPrec @@ -50,116 +56,133 @@ instance Show1 Let where liftShowsPrec = genericLiftShowsPrec -- | Assignment to a variable or other lvalue. data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Assignment where liftEq = genericLiftEq +instance Ord1 Assignment where liftCompare = genericLiftCompare instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec -- Returns newtype Return a = Return a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Return where liftEq = genericLiftEq +instance Ord1 Return where liftCompare = genericLiftCompare instance Show1 Return where liftShowsPrec = genericLiftShowsPrec newtype Yield a = Yield a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Yield where liftEq = genericLiftEq +instance Ord1 Yield where liftCompare = genericLiftCompare instance Show1 Yield where liftShowsPrec = genericLiftShowsPrec newtype Break a = Break a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Break where liftEq = genericLiftEq +instance Ord1 Break where liftCompare = genericLiftCompare instance Show1 Break where liftShowsPrec = genericLiftShowsPrec newtype Continue a = Continue a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Continue where liftEq = genericLiftEq +instance Ord1 Continue where liftCompare = genericLiftCompare instance Show1 Continue where liftShowsPrec = genericLiftShowsPrec newtype Retry a = Retry a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Retry where liftEq = genericLiftEq +instance Ord1 Retry where liftCompare = genericLiftCompare instance Show1 Retry where liftShowsPrec = genericLiftShowsPrec newtype NoOp a = NoOp a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NoOp where liftEq = genericLiftEq +instance Ord1 NoOp where liftCompare = genericLiftCompare instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec -- Loops data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 For where liftEq = genericLiftEq +instance Ord1 For where liftCompare = genericLiftCompare instance Show1 For where liftShowsPrec = genericLiftShowsPrec data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ForEach where liftEq = genericLiftEq +instance Ord1 ForEach where liftCompare = genericLiftCompare instance Show1 ForEach where liftShowsPrec = genericLiftShowsPrec data While a = While { whileCondition :: !a, whileBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 While where liftEq = genericLiftEq +instance Ord1 While where liftCompare = genericLiftCompare instance Show1 While where liftShowsPrec = genericLiftShowsPrec data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 DoWhile where liftEq = genericLiftEq +instance Ord1 DoWhile where liftCompare = genericLiftCompare instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec -- Exception handling newtype Throw a = Throw a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Throw where liftEq = genericLiftEq +instance Ord1 Throw where liftCompare = genericLiftCompare instance Show1 Throw where liftShowsPrec = genericLiftShowsPrec data Try a = Try { tryBody :: !a, tryCatch :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Try where liftEq = genericLiftEq +instance Ord1 Try where liftCompare = genericLiftCompare instance Show1 Try where liftShowsPrec = genericLiftShowsPrec data Catch a = Catch { catchException :: !a, catchBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Catch where liftEq = genericLiftEq +instance Ord1 Catch where liftCompare = genericLiftCompare instance Show1 Catch where liftShowsPrec = genericLiftShowsPrec newtype Finally a = Finally a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Finally where liftEq = genericLiftEq +instance Ord1 Finally where liftCompare = genericLiftCompare instance Show1 Finally where liftShowsPrec = genericLiftShowsPrec -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl). newtype ScopeEntry a = ScopeEntry [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ScopeEntry where liftEq = genericLiftEq +instance Ord1 ScopeEntry where liftCompare = genericLiftCompare instance Show1 ScopeEntry where liftShowsPrec = genericLiftShowsPrec -- | ScopeExit (e.g. `END {}` block in Ruby or Perl). newtype ScopeExit a = ScopeExit [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ScopeExit where liftEq = genericLiftEq +instance Ord1 ScopeExit where liftCompare = genericLiftCompare instance Show1 ScopeExit where liftShowsPrec = genericLiftShowsPrec From 881bf627550fe3c8c53b55004d0f36992c05b3b9 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 10 Oct 2017 13:18:01 -0700 Subject: [PATCH 3/3] Derive Ord instance for Comment --- src/Data/Syntax/Comment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 0e1d7aeec..6c6742b6a 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -12,7 +12,7 @@ import GHC.Generics -- | An unnested comment (line or block). newtype Comment a = Comment { commentContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Comment where liftEq = genericLiftEq instance Ord1 Comment where liftCompare = genericLiftCompare