Merge pull request #1096 from github/ruby-control-flow-a-la-carte

Ruby control flow à la carte

src/Data/Syntax/Comment.hs

@@ -15,3 +15,4 @@ instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec
 -- TODO: nested comment types
 -- TODO: documentation comment types
 -- TODO: literate programming comment types? alternatively, consider those as markup
+-- TODO: Differentiate between line/block comments?

src/Data/Syntax/Expression.hs

@@ -19,3 +19,11 @@ data Not a = Not a
 
 instance Eq1 Not where liftEq = genericLiftEq
 instance Show1 Not where liftShowsPrec = genericLiftShowsPrec
+
+
+-- | Binary addition.
+data Plus a = Plus a a
+  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+
+instance Eq1 Plus where liftEq = genericLiftEq
+instance Show1 Plus where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Literal.hs

@@ -35,6 +35,14 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
 -- TODO: Should IntegerLiteral hold an Integer instead of a ByteString?
 -- TODO: Do we care about differentiating between hex/octal/decimal/binary integer literals?
 -- TODO: Float/Double literals.
+-- TODO: Consider a Numeric datatype with FloatingPoint/Integral/etc constructors.
+
+
+data Range a = Range { rangeStart :: a, rangeEnd :: a }
+  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+
+instance Eq1 Range where liftEq = genericLiftEq
+instance Show1 Range where liftShowsPrec = genericLiftShowsPrec
 
 
 -- Strings, symbols
@@ -63,13 +71,15 @@ instance Eq1 TextElement where liftEq = genericLiftEq
 instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec
 
 
-newtype Symbol a = SymbolLiteral { symbolContent :: ByteString }
+newtype Symbol a = Symbol { symbolContent :: ByteString }
   deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
 instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 
+-- TODO: Heredoc-style string literals?
 -- TODO: Character literals.
+-- TODO: Regular expressions.
 
 
 -- Collections

src/Data/Syntax/Statement.hs

@@ -30,6 +30,16 @@ instance Eq1 Pattern where liftEq = genericLiftEq
 instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec
 
 
+-- Assignment
+
+-- | Assignment to a variable or other lvalue.
+data Assignment a = Assignment { assignmentTarget :: !a, assignmentValue :: !a }
+  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+
+instance Eq1 Assignment where liftEq = genericLiftEq
+instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
+
+
 -- Returns
 
 newtype Return a = Return a

src/Language/Ruby/Syntax.hs

@@ -12,7 +12,7 @@ import qualified Data.Syntax.Expression as Expression
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import Language.Haskell.TH hiding (location, Range(..))
-import Prologue hiding (get, Location, optional, state, unless)
+import Prologue hiding (for, get, Location, optional, state, unless)
 import Term
 import Text.Parser.TreeSitter.Language
 import Text.Parser.TreeSitter.Ruby
@@ -28,12 +28,17 @@ type Syntax' =
   , Literal.Boolean
   , Literal.Hash
   , Literal.Integer
+  , Literal.Range
   , Literal.String
   , Literal.Symbol
   , Statement.Break
   , Statement.Continue
+  , Statement.ForEach
   , Statement.If
+  -- TODO: redo
+  -- TODO: retry
   , Statement.Return
+  , Statement.While
   , Statement.Yield
   , Syntax.Empty
   , Syntax.Identifier
@@ -72,32 +77,42 @@ statement  =  exit Statement.Return Return
           <|> exit Statement.Break Break
           <|> exit Statement.Continue Next
           <|> if'
-          <|> ifModifier
           <|> unless
-          <|> unlessModifier
+          <|> while
+          <|> until
+          <|> for
           <|> literal
-  where exit construct sym = symbol sym *> term <*> (children (construct <$> optional (symbol ArgumentList *> children statement)))
+  where exit construct sym = symbol sym *> term <*> children (construct <$> optional (symbol ArgumentList *> children statement))
 
 comment :: Assignment (Node Grammar) (Term Syntax Location)
 comment = leaf Comment Comment.Comment
 
 if' :: Assignment (Node Grammar) (Term Syntax Location)
-if' = go If
-  where go s = symbol s *> term <*> children (Statement.If <$> statement <*> (term <*> many statement) <*> optional (go Elsif <|> symbol Else *> term <*> children (many statement)))
-
-ifModifier :: Assignment (Node Grammar) (Term Syntax Location)
-ifModifier = symbol IfModifier *> term <*> children (flip Statement.If <$> statement <*> statement <*> (term <*> pure Syntax.Empty))
+if' =  ifElsif If
+   <|> symbol IfModifier     *> term <*> children (flip Statement.If <$> statement <*> statement <*> (term <*> pure Syntax.Empty))
+  where ifElsif s = symbol s *> term <*> children      (Statement.If <$> statement <*> (term <*> many statement) <*> optional (ifElsif Elsif <|> symbol Else *> term <*> children (many statement)))
 
 unless :: Assignment (Node Grammar) (Term Syntax Location)
 unless =  symbol Unless         *> term <*> children      (Statement.If <$> (term <*> (Expression.Not <$> statement)) <*> (term <*> many statement) <*> optional (symbol Else *> term <*> children (many statement)))
+      <|> symbol UnlessModifier *> term <*> children (flip Statement.If <$> statement <*> (term <*> (Expression.Not <$> statement)) <*> (term <*> pure Syntax.Empty))
 
-unlessModifier :: Assignment (Node Grammar) (Term Syntax Location)
-unlessModifier = symbol UnlessModifier *> term <*> children (flip Statement.If <$> statement <*> (term <*> (Expression.Not <$> statement)) <*> (term <*> pure Syntax.Empty))
+while :: Assignment (Node Grammar) (Term Syntax Location)
+while =  symbol While         *> term <*> children      (Statement.While <$> statement <*> (term <*> many statement))
+     <|> symbol WhileModifier *> term <*> children (flip Statement.While <$> statement <*> statement)
+
+until :: Assignment (Node Grammar) (Term Syntax Location)
+until =  symbol Until         *> term <*> children      (Statement.While <$> (term <*> (Expression.Not <$> statement)) <*> (term <*> many statement))
+     <|> symbol UntilModifier *> term <*> children (flip Statement.While <$> statement <*> (term <*> (Expression.Not <$> statement)))
+
+for :: Assignment (Node Grammar) (Term Syntax Location)
+for = symbol For *> term <*> children (Statement.ForEach <$> identifier <*> statement <*> (term <*> many statement))
 
 literal :: Assignment (Node Grammar) (Term Syntax Location)
 literal  =  leaf Language.Ruby.Syntax.True (const Literal.true)
         <|> leaf Language.Ruby.Syntax.False (const Literal.false)
         <|> leaf Language.Ruby.Syntax.Integer Literal.Integer
+        <|> leaf Symbol Literal.Symbol
+        <|> symbol Range *> term <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
 -- | Assignment of the current node’s annotation.
 term :: InUnion Syntax' f => Assignment (Node grammar) (f (Term Syntax Location) -> Term Syntax Location)

src/Source.hs

@@ -2,13 +2,14 @@
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 module Source where
 
-import Prelude (FilePath)
-import Prologue
 import qualified Data.ByteString as B
+import Data.String (IsString(..))
 import qualified Data.Text as T
 import Numeric
 import Range
+import Prologue
 import SourceSpan
+import System.IO (FilePath)
 import Test.LeanCheck
 
 -- | The source, oid, path, and Maybe SourceKind of a blob.
@@ -21,7 +22,7 @@ data SourceBlob = SourceBlob
 
 -- | The contents of a source file, represented as a ByteString.
 newtype Source = Source { sourceText :: B.ByteString }
-  deriving (Eq, Show)
+  deriving (Eq, IsString, Show)
 
 -- | The kind of a blob, along with it's file mode.
 data SourceKind = PlainBlob Word32  | ExecutableBlob Word32 | SymlinkBlob Word32