diff --git a/src/Language/Cimple/Ast.hs b/src/Language/Cimple/Ast.hs index fb68781..f90d830 100644 --- a/src/Language/Cimple/Ast.hs +++ b/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 (..) diff --git a/src/Language/Cimple/DescribeAst.hs b/src/Language/Cimple/DescribeAst.hs index 56ceb41..ca60ffa 100644 --- a/src/Language/Cimple/DescribeAst.hs +++ b/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 = "..." diff --git a/src/Language/Cimple/Diagnostics.hs b/src/Language/Cimple/Diagnostics.hs index 1fe8f2e..c6ba0b9 100644 --- a/src/Language/Cimple/Diagnostics.hs +++ b/src/Language/Cimple/Diagnostics.hs @@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} module Language.Cimple.Diagnostics ( Diagnostics , HasDiagnostics (..) diff --git a/src/Language/Cimple/Flatten.hs b/src/Language/Cimple/Flatten.hs index e912c55..8aa484f 100644 --- a/src/Language/Cimple/Flatten.hs +++ b/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 diff --git a/src/Language/Cimple/IO.hs b/src/Language/Cimple/IO.hs index 28aa40f..aa6da20 100644 --- a/src/Language/Cimple/IO.hs +++ b/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 diff --git a/src/Language/Cimple/MapAst.hs b/src/Language/Cimple/MapAst.hs index 6bc3d89..e423e23 100644 --- a/src/Language/Cimple/MapAst.hs +++ b/src/Language/Cimple/MapAst.hs @@ -4,7 +4,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilies #-} module Language.Cimple.MapAst ( mapAst diff --git a/src/Language/Cimple/Parser.y b/src/Language/Cimple/Parser.y index 8b5eaf9..ed26583 100644 --- a/src/Language/Cimple/Parser.y +++ b/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 diff --git a/src/Language/Cimple/Pretty.hs b/src/Language/Cimple/Pretty.hs index dadd4fc..18f878a 100644 --- a/src/Language/Cimple/Pretty.hs +++ b/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 @@ -275,8 +277,9 @@ ppVerbatimComment = 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) diff --git a/src/Language/Cimple/SemCheck/Includes.hs b/src/Language/Cimple/SemCheck/Includes.hs index 59d16f3..4d1af2b 100644 --- a/src/Language/Cimple/SemCheck/Includes.hs +++ b/src/Language/Cimple/SemCheck/Includes.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} +{-# LANGUAGE Strict #-} module Language.Cimple.SemCheck.Includes ( collectIncludes , normaliseIncludes diff --git a/src/Language/Cimple/TraverseAst.hs b/src/Language/Cimple/TraverseAst.hs index b5707bd..de07ad9 100644 --- a/src/Language/Cimple/TraverseAst.hs +++ b/src/Language/Cimple/TraverseAst.hs @@ -5,7 +5,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilies #-} module Language.Cimple.TraverseAst ( traverseAst diff --git a/tools/count-tokens.hs b/tools/count-tokens.hs index 9f3f3d4..96d4a57 100644 --- a/tools/count-tokens.hs +++ b/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