feat: Add support for parsing expressions and statements.

src/Language/Cimple/Ast.hs

@@ -1,10 +1,8 @@
-{-# LANGUAGE DeriveFunctor     #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DerivingVia       #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE Strict            #-}
-{-# LANGUAGE StrictData        #-}
 module Language.Cimple.Ast
     ( AssignOp (..)
     , BinaryOp (..)

src/Language/Cimple/DescribeAst.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Strict            #-}
-{-# LANGUAGE StrictData        #-}
 module Language.Cimple.DescribeAst
     ( HasLocation (..)
     , describeLexeme
@@ -34,7 +33,7 @@ describeNode node = case unFix node of
     PreprocIf{}     -> "#if/#endif block"
     PreprocIfdef{}  -> "#ifdef/#endif block"
     PreprocIfndef{} -> "#ifndef/#endif block"
-    _               -> show $ (const ellipsis) <$> unFix node
+    _               -> show $ ellipsis <$ unFix node
   where
     ellipsis :: String
     ellipsis = "..."

src/Language/Cimple/Diagnostics.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Strict            #-}
-{-# LANGUAGE StrictData        #-}
 module Language.Cimple.Diagnostics
   ( Diagnostics
   , HasDiagnostics (..)

src/Language/Cimple/Flatten.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Strict                #-}
-{-# LANGUAGE StrictData            #-}
 {-# LANGUAGE TypeOperators         #-}
 module Language.Cimple.Flatten (lexemes) where
 
@@ -81,7 +80,7 @@ instance GenConcatsFlatten (Fix (CommentF a)) a where
     gconcatsFlatten (Fix (DocRParen x)) = gconcatsFlatten x
     gconcatsFlatten (Fix (DocSee r x)) = r : gconcatsFlatten x
     gconcatsFlatten (Fix (DocSentence x p)) = gconcatsFlatten x ++ [p]
-    gconcatsFlatten (Fix (DocULItem i x)) = concat [gconcatsFlatten i, gconcatsFlatten x]
+    gconcatsFlatten (Fix (DocULItem i x)) = gconcatsFlatten i ++ gconcatsFlatten x
     gconcatsFlatten (Fix (DocWord x)) = [x]
 
 instance GenConcatsFlatten t a => GenConcats (Rec0 t) a where

src/Language/Cimple/IO.hs

@@ -1,9 +1,10 @@
-{-# LANGUAGE Strict     #-}
-{-# LANGUAGE StrictData #-}
+{-# LANGUAGE Strict #-}
 module Language.Cimple.IO
-    ( parseFile
+    ( parseExpr
+    , parseFile
     , parseFiles
     , parseProgram
+    , parseStmt
     , parseText
     ) where
 
@@ -16,7 +17,7 @@ import qualified Data.Map.Strict                 as Map
 import           Data.Text                       (Text)
 import qualified Data.Text.Encoding              as Text
 import           Language.Cimple.Ast             (Node)
-import           Language.Cimple.Lexer           (Lexeme, runAlex)
+import           Language.Cimple.Lexer           (Alex, Lexeme, runAlex)
 import           Language.Cimple.MapAst          (TextActions, mapAst,
                                                   textActions)
 import qualified Language.Cimple.Parser          as Parser
@@ -43,8 +44,17 @@ cacheText textAst =
                 return text
 
 
+runText :: Alex a -> Text -> Either String a
+runText f = flip runAlex f . LBS.fromStrict . Text.encodeUtf8
+
+parseExpr :: Text -> Either String TextNode
+parseExpr = runText Parser.parseStmt
+
+parseStmt :: Text -> Either String TextNode
+parseStmt = runText Parser.parseStmt
+
 parseText :: Text -> Either String [TextNode]
-parseText = fmap cacheText . flip runAlex Parser.parseTranslationUnit . LBS.fromStrict . Text.encodeUtf8
+parseText = fmap cacheText . runText Parser.parseTranslationUnit
 
 parseBytes :: LBS.ByteString -> Either String [TextNode]
 parseBytes = flip runAlex Parser.parseTranslationUnit

src/Language/Cimple/MapAst.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE Strict                #-}
-{-# LANGUAGE StrictData            #-}
 {-# LANGUAGE TypeFamilies          #-}
 module Language.Cimple.MapAst
     ( mapAst

src/Language/Cimple/Parser.y

@@ -1,7 +1,9 @@
 {
 {-# LANGUAGE OverloadedStrings #-}
 module Language.Cimple.Parser
-    ( parseTranslationUnit
+    ( parseExpr
+    , parseStmt
+    , parseTranslationUnit
     ) where
 
 import           Data.Fix               (Fix (..))
@@ -20,6 +22,8 @@ import           Language.Cimple.Tokens (LexemeClass (..))
 %expect 2
 
 %name parseTranslationUnit TranslationUnit
+%name parseExpr Expr
+%name parseStmt Stmt
 
 %error {parseError}
 %errorhandlertype explist

src/Language/Cimple/Pretty.hs

@@ -1,6 +1,8 @@
 {-# OPTIONS_GHC -Wno-missing-signatures #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
+{- HLINT ignore "Functor law" -}
+{- HLINT ignore "Use <$" -}
 module Language.Cimple.Pretty
     ( plain
     , render
@@ -20,16 +22,16 @@
                                                UnaryOp (..), lexemeLine,
                                                lexemeText)
 import           Prelude                      hiding ((<$>))
 import           Text.PrettyPrint.ANSI.Leijen
 
 indentWidth :: Int
 indentWidth = 2
 
 kwBreak         = dullred   $ text "break"
 kwCase          = dullred   $ text "case"
 kwConst         = dullgreen $ text "const"
 kwContinue      = dullred   $ text "continue"
 kwDefault       = dullred   $ text "default"
 kwDo            = dullred   $ text "do"
 kwElse          = dullred   $ text "else"
 kwEnum          = dullgreen $ text "enum"
@@ -275,8 +277,9 @@
 ppCommentInfo :: Comment (Lexeme Text) -> Doc
 ppCommentInfo = foldFix go
   where
-  ppBody     = vcat . zipWith (<>) (        repeat (dullyellow (text " * "  )))
-  ppIndented = vcat . zipWith (<>) (empty : repeat (dullyellow (text " *   ")))
+  commentStart t = repeat (dullyellow (text t))
+  ppBody     = vcat . zipWith (<>) (        commentStart " * "  )
+  ppIndented = vcat . zipWith (<>) (empty : commentStart " *   ")
   ppRef      = underline . cyan . ppLexeme
   ppAttr     = maybe empty (blue . ppLexeme)
 

src/Language/Cimple/SemCheck/Includes.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE Strict     #-}
-{-# LANGUAGE StrictData #-}
+{-# LANGUAGE Strict #-}
 module Language.Cimple.SemCheck.Includes
   ( collectIncludes
   , normaliseIncludes

src/Language/Cimple/TraverseAst.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE Strict                #-}
-{-# LANGUAGE StrictData            #-}
 {-# LANGUAGE TypeFamilies          #-}
 module Language.Cimple.TraverseAst
     ( traverseAst

tools/count-tokens.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE Strict #-}
 module Main (main) where
 
+import           Data.Bifunctor       (bimap)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text            as Text
 import           Data.Time.Clock      (diffUTCTime, getCurrentTime)
@@ -27,7 +28,7 @@ processFile source = do
         Right ok -> return ok
 
 processFiles :: [FilePath] -> IO (Int, Int)
-processFiles = fmap ((\(a, b) -> (sum a, sum b)) . unzip) . mapM processFile
+processFiles = fmap (bimap sum sum . unzip) . mapM processFile
 
 main :: IO ()
 main = do