From 6161665de70bd8661cb43b072ed44b7e8aecb264 Mon Sep 17 00:00:00 2001 From: iphydf Date: Fri, 10 Apr 2020 02:21:54 +0000 Subject: [PATCH] Split out "cimple" parser out of tokstyle. Also, added support for some apidsl-like language. This will become apidsl v2. --- .gitignore | 16 ++- .travis.yml | 26 ++-- BUILD.bazel | 56 ++++++-- Procfile | 1 - README.md | 4 +- appveyor.yml | 17 --- cimple.cabal | 89 ++++++++++++ src/Language/Cimple.hs | 6 + src/{Tokstyle => Language}/Cimple/AST.hs | 20 ++- .../Cimple/Diagnostics.hs | 4 +- src/{Tokstyle => Language}/Cimple/IO.hs | 8 +- src/{Tokstyle => Language}/Cimple/Lexer.x | 23 ++- src/{Tokstyle => Language}/Cimple/Parser.y | 134 ++++++++++++++---- src/{Tokstyle => Language}/Cimple/Tokens.hs | 17 ++- .../Cimple/TraverseAst.hs | 38 ++++- src/Tokstyle/C.hs | 72 ---------- src/Tokstyle/C/Naming.hs | 78 ---------- src/Tokstyle/Cimple/Analysis.hs | 18 --- src/Tokstyle/Cimple/Analysis/FuncScopes.hs | 36 ----- src/Tokstyle/Cimple/Analysis/GlobalFuncs.hs | 19 --- src/Tokstyle/Cimple/Analysis/LoggerCalls.hs | 39 ----- .../Cimple/Analysis/LoggerNoEscapes.hs | 45 ------ src/Tokstyle/Result.hs | 31 ---- src/Tokstyle/Sources.hs | 65 --------- stack.yaml | 3 + test/Language/CimpleSpec.hs | 68 +++++++++ test/Tokstyle/CimpleSpec.hs | 53 ------- tokstyle.cabal | 126 ---------------- tools/BUILD.bazel | 21 +-- tools/check-c.hs | 7 - tools/check-cimple.hs | 30 ---- tools/dump-ast.hs | 23 +++ tools/dump-tokens.hs | 18 +-- web/Tokstyle/App.hs | 58 -------- web/webservice.hs | 24 ---- 35 files changed, 478 insertions(+), 815 deletions(-) delete mode 100644 Procfile delete mode 100644 appveyor.yml create mode 100644 cimple.cabal create mode 100644 src/Language/Cimple.hs rename src/{Tokstyle => Language}/Cimple/AST.hs (87%) rename src/{Tokstyle => Language}/Cimple/Diagnostics.hs (79%) rename src/{Tokstyle => Language}/Cimple/IO.hs (87%) rename src/{Tokstyle => Language}/Cimple/Lexer.x (92%) rename src/{Tokstyle => Language}/Cimple/Parser.y (80%) rename src/{Tokstyle => Language}/Cimple/Tokens.hs (92%) rename src/{Tokstyle => Language}/Cimple/TraverseAst.hs (84%) delete mode 100644 src/Tokstyle/C.hs delete mode 100644 src/Tokstyle/C/Naming.hs delete mode 100644 src/Tokstyle/Cimple/Analysis.hs delete mode 100644 src/Tokstyle/Cimple/Analysis/FuncScopes.hs delete mode 100644 src/Tokstyle/Cimple/Analysis/GlobalFuncs.hs delete mode 100644 src/Tokstyle/Cimple/Analysis/LoggerCalls.hs delete mode 100644 src/Tokstyle/Cimple/Analysis/LoggerNoEscapes.hs delete mode 100644 src/Tokstyle/Result.hs delete mode 100644 src/Tokstyle/Sources.hs create mode 100644 test/Language/CimpleSpec.hs delete mode 100644 test/Tokstyle/CimpleSpec.hs delete mode 100644 tokstyle.cabal delete mode 100644 tools/check-c.hs delete mode 100644 tools/check-cimple.hs create mode 100644 tools/dump-ast.hs delete mode 100644 web/Tokstyle/App.hs delete mode 100644 web/webservice.hs diff --git a/.gitignore b/.gitignore index d290a0b..005e8c9 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,15 @@ -/.stack-work -/stack.yaml.lock +# Build products. +/dist +/*.tix +/.*.pid +/.*.stamp + +/.cabal-sandbox /cabal.config /cabal.sandbox.config -/dist +/.stack-work +/stack.yaml.lock + +# Temporary files. +*~ +*.swp diff --git a/.travis.yml b/.travis.yml index b8ae0fe..3e4e2f6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,25 +3,35 @@ language: generic dist: xenial os: linux -env: PACKAGE=tokstyle TARGET=x86_64-linux +env: + global: + # HACKAGE_USERNAME=[secure] + - secure: "zQfxfmcR9ZOlN2/9PsvPKuPQldhJbGskYtpUo50WW0n1qGUwEYbLZEs0S4Mt/7Dyp17z3JG0fYLX2CI6M/pOLSVgqwEmzlN2tqZ1mtstABQPzI2tx/s1E7Vj1424NW56Hl85W1ZDK2EhuDYhJn+E9Sd7h1p1GL+W4KQMwXeV9J0Q0MXD76R2aIPh85UmVIMtzCJwxm+xei2eag2TluytGQurqZWNtk2wB2734HcdJYhK36f7lZOhyg9ugFliHv7wAoSaAMqgkV9mLl9xa7E4MFahfpW5dMoitsrLJWAbrvPeekrtyxzlDhsvfESkyD4uzCOEHApvL0iqseQ2cRoDIOKCVnkGhMc4b/T68sLTrz5qxhqNXrTnsMI5Co+HVOym0fUT4vq1eluKfEaHmmR9w2Mnel7yi9oxn7inbGRAWdaLa6w+Q9bLjGgs7j8fUBpxRsBgMQJPzIyNoRtm+UD3WksDiIDRwXRwSS/09YcpK2lC5cEyi5hxeh8t0G5ft2j7/zkwXen+dZ2J3wVHjy5M5MteeBMk4dI/Uhkgtf7XDSVoZru2/3+RHlM5yMBa5OtV7vnKPQg4tktymRCzkWx57XSblWQ2cor6GL5GmIRfSTkUZuBfpfaaCZPXhyLHuBPGGCLN9gluCH0PZIq1f2wuGZV5iVzfBT3clhbepC6sw80=" + # HACKAGE_PASSWORD=[secure] + - secure: "d1fxqa5o87mP2xnXkWdlXVKrIsz24ZfMEIUuc9m9GEHmZalmt8tlm//6PjC26Hu9IPRYIxFP5I7lYK0jija1xBHtwzR4lB9OZb86YuhSI6+upEgjOtrko9bM6uvSqaWCQAxjdJczpbVqVBPNEL02JDlG3GnBcOWDSCnWonLnMgwSHvmG7yxCe8VToR696hd6rr0bSLgWa0Ck17osqxHUg9S+QJ1xeNIorFBPleimhVyK9Agzk4a8GnNh5G7zoppt/Ti11l+mcHH0KwDWOHQ+nODRonpeWinVC5qvkc99IKyNgB66cS/UJOvTEdqC0xpozBSW8mTVu6MFW2GmR9I7wQHNEEctA7eTYDSoPJH4CKt3qL6XuNzsa6IxpG9z3q+/lxRqqXn/CPhi4xGSaqnqyAJhNEFe2kPYwY0w7WJEf93q/ougb+8kd0cwxKQrW94AvEKFU902NqHwUhbhP+O8JburMn8UjnBUXw9bNEQXGkD1MyUikK/KuzLMUC4CYEhFAE9TJgtYC8CYh8bPYGRJvr3fuzBjK+12MoeIYAQTcS+43RzK0OCb2chLC0f5137wq65m+20HhJ1ApmfMzjsh49D/SSQKEWriutm4mEHrBRyaSkTRyZMf13RgygS7Fz1X0Emt+F9rHgxNCDUfgjcP0rdsUn0B0Gb/ZRfrmA4fyKA=" cache: - timeout: 3 + timeout: 600 directories: + - $HOME/.local - $HOME/.stack script: - bash <(travis_retry curl -s https://raw.githubusercontent.com/TokTok/hs-tools/master/bin/travis-haskell) script - - ./expand_yacc.pl src/Tokstyle/Cimple/Parser.y src/Tokstyle/Cimple/Parser.y - - stack install - - tar zcf $PACKAGE-$TARGET-$TRAVIS_TAG.tar.gz -C $HOME/.local $(grep executable $PACKAGE.cabal | awk '{print "bin/"$2}') + - eval $(travis-haskell env) deploy: provider: releases token: - secure: "o1WqCKpiHuNK/YLwfMZyCVJAVYWs4Yz+4P3khO6gU7xfjVZ7Pbv62xdUJH57lfBIpAiPKOTD0mVrX/anfjrgKR3Ecr05oAj6JEtgLJm8G8fx4YepWpjc9k1ZhPxSkMmo6f5Y41uIyQsxYXxqWjQ4A3cvkxKv0LehXfPfWeQQgFL6ywl2r5oahmdqXha+v5+af+Gqpnsc9Ji8MlA6AOWCyT8A4I6QEqUgSqOqjEIojvpDGZkUCesv84pUjZ5D6Ur/3olAZmP+1he6HCy/IqExhAZeJ7QG91/VBG2G1iOsIU7TeTGi0ssoEV//pk7r9sIYJqbfCXcXbt9yokURgxb1A9y+1SMAfXm60USOM7hZRfZE95rnrm36bi60usUrf4TcdnwqlrpAgH+GfcA1ykdDLC0ghZWn/gnOHMAKivJuGuz4em9UUwKFQzF3Vh2Ud7bIJW3D2MynNDXB190qI6/pzccXyn+3LSRL7mdBUdvtCetRhfsczLPfggfY/ydRUzVyKvyMO3PCAH93vtbwkPzCUhMpNH514mo1DP0k0vZbDY5u9gwnhs40CMGbU8POvboMZwrQ2rPpsvfBUoWasU+gAQeAUPq5fzcUEbo53PUAiH063kPNmgQTO8guyBwm+kK5kzeQuNx4g7Vbf7tYM1Kh2fE10SVH15n/EepAl8Db7JY=" - file: $PACKAGE-$TARGET-$TRAVIS_TAG.tar.gz + secure: "QZ67vjK2QsINgCUqUTXoiOeQ+D3zpSpoSoIM1LC7EYbUMxfQyzdFP+MAy9nggV0mnY52AR3cCSr/gNv5ytWrLnV8dIF7ht32ekpr3jnv7D+Rb3NmgMQkLMI92cF5OP777EBWGALrYGtRqj/nkSElOKBtLeXb3JBaaRiQFecIsAxe1TrVNnlrZ59F1+hT4zoaWeu2VwovWHiO+bj1Qv6Z1KsyHNyHeEMvBhFzOLSRtvKBqr8JR/U08Y+5CbelxUxw/EPuTPribv2EHlHFIcx9/3MkVlpHgVC8UhyIgYoRXWDbgBeXePPBhCo0xw6eiJ7a9vLDPXK6nbcJkroSveTPRqrk5O2GYyEtQClKQ098aeB/yDIl2cHDgCO2U+gU8gxTBT5d8JgOMl7UlI3Z7I0GHTBX6gSLsiRxz44eoEsgi/9L9L2bFe3STZreEXMCqvELZnwUNjIkO6GfN3OmV/kr5GREnh12OfDiIB8vGWc7dFNUvks/l7XOuPB6U0VAf+yieuaoGstlDidJE+R/7rBLhV6cSyG2i25KMUN4bG6EZgm45CcQ0Rq5Q2uWLzB7pmY/4Jp6FWiLieqxJLs1EMwPnJ9dSGQw4Pxw8K3rSj7ed2mqFlfZdIVKLzxkv8Yp823MFCV7OECRoBTNWpX/ibC/294jnJn84hmdKrGmDScJF7M=" + file: $PACKAGE-$VERSION.tar.gz skip_cleanup: true on: - repo: TokTok/hs-tokstyle + repo: TokTok/hs-cimple tags: true + +after_deploy: travis-haskell deploy + +# Only build pull requests and releases, don't build master on pushes, +# except through api or cron. +if: type IN (pull_request, api, cron) OR tag IS present diff --git a/BUILD.bazel b/BUILD.bazel index e11794a..61bfb72 100644 --- a/BUILD.bazel +++ b/BUILD.bazel @@ -9,35 +9,67 @@ project() alex_lexer( name = "Lexer", - src = "src/Tokstyle/Cimple/Lexer.x", + src = "src/Language/Cimple/Lexer.x", +) + +haskell_library( + name = "lexer", + srcs = [ + "src/Language/Cimple/Lexer.hs", + "src/Language/Cimple/Tokens.hs", + ], + src_strip_prefix = "src", + visibility = ["//hs-cimple:__subpackages__"], + deps = [ + hazel_library("aeson"), + hazel_library("array"), + hazel_library("base"), + ], ) happy_parser( name = "Parser", - src = "src/Tokstyle/Cimple/Parser.y", + src = "src/Language/Cimple/Parser.y", preproc = "expand_yacc.pl", ) haskell_library( - name = "hs-tokstyle", - srcs = glob(["src/**/*.*hs"]) + [ - "src/Tokstyle/Cimple/Lexer.hs", - "src/Tokstyle/Cimple/Parser.hs", + name = "parser", + srcs = [ + "src/Language/Cimple/AST.hs", + "src/Language/Cimple/Parser.hs", ], src_strip_prefix = "src", - version = "0.0.5", + visibility = ["//hs-cimple:__subpackages__"], + deps = [ + ":lexer", + hazel_library("aeson"), + hazel_library("array"), + hazel_library("base"), + ], +) + +haskell_library( + name = "hs-cimple", + srcs = glob( + ["src/**/*.*hs"], + exclude = [ + "src/Language/Cimple/AST.hs", + "src/Language/Cimple/Tokens.hs", + ], + ), + src_strip_prefix = "src", + version = "0.0.1", visibility = ["//visibility:public"], deps = [ + ":lexer", + ":parser", hazel_library("aeson"), hazel_library("array"), hazel_library("base"), hazel_library("bytestring"), hazel_library("compact"), hazel_library("containers"), - hazel_library("deepseq"), - hazel_library("filepath"), - hazel_library("groom"), - hazel_library("language-c"), hazel_library("mtl"), hazel_library("text"), ], @@ -47,7 +79,7 @@ hspec_test( name = "testsuite", size = "small", deps = [ - ":hs-tokstyle", + ":hs-cimple", hazel_library("base"), hazel_library("hspec"), ], diff --git a/Procfile b/Procfile deleted file mode 100644 index d2853ee..0000000 --- a/Procfile +++ /dev/null @@ -1 +0,0 @@ -web: webservice $PORT diff --git a/README.md b/README.md index 93ec629..dea4028 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,3 @@ -# Tokstyle +# Haskell package: cimple -C style checker for TokTok projects. +Parser for a dialect of C including Apidsl. diff --git a/appveyor.yml b/appveyor.yml deleted file mode 100644 index 9394776..0000000 --- a/appveyor.yml +++ /dev/null @@ -1,17 +0,0 @@ ---- -cache: - - '%APPDATA%\cabal' - - '%APPDATA%\ghc' - -install: - - choco install ghc --version 8.2.2 - - refreshenv - -build_script: - - cabal update - - cabal install alex happy --overwrite-policy=always - - cabal configure --enable-tests --enable-benchmarks - - cabal build - -test_script: - - cabal test diff --git a/cimple.cabal b/cimple.cabal new file mode 100644 index 0000000..7b66982 --- /dev/null +++ b/cimple.cabal @@ -0,0 +1,89 @@ +name: cimple +version: 0.0.1 +synopsis: Simple C-like programming language +homepage: https://toktok.github.io/ +license: GPL-3 +license-file: LICENSE +author: Iphigenia Df +maintainer: Iphigenia Df +copyright: Copyright (c) 2016-2020, Iphigenia Df +category: Data +stability: Experimental +cabal-version: >= 1.10 +build-type: Simple +description: + Parser and AST for Cimple, a simple C-like programming language. + +source-repository head + type: git + location: https://github.com/TokTok/hs-cimple + +library + default-language: Haskell2010 + hs-source-dirs: + src + ghc-options: + -Wall + build-tools: alex, happy + exposed-modules: + Language.Cimple + , Language.Cimple.Diagnostics + , Language.Cimple.IO + , Language.Cimple.TraverseAst + other-modules: + Language.Cimple.AST + , Language.Cimple.Lexer + , Language.Cimple.Parser + , Language.Cimple.Tokens + build-depends: + base < 5 + , aeson + , array + , bytestring + , compact + , containers + , mtl + , text + +executable dump-ast + default-language: Haskell2010 + hs-source-dirs: + tools + ghc-options: + -Wall + main-is: dump-ast.hs + build-depends: + base < 5 + , bytestring + , cimple + , groom + , text + +executable dump-tokens + default-language: Haskell2010 + hs-source-dirs: + tools + ghc-options: + -Wall + main-is: dump-tokens.hs + build-depends: + base < 5 + , bytestring + , cimple + , groom + , text + +test-suite testsuite + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: testsuite.hs + other-modules: + Language.CimpleSpec + ghc-options: + -Wall + -fno-warn-unused-imports + build-depends: + base < 5 + , cimple + , hspec diff --git a/src/Language/Cimple.hs b/src/Language/Cimple.hs new file mode 100644 index 0000000..f627d9f --- /dev/null +++ b/src/Language/Cimple.hs @@ -0,0 +1,6 @@ +module Language.Cimple (module X) where + +import Language.Cimple.AST as X +import Language.Cimple.Lexer as X +import Language.Cimple.Parser as X +import Language.Cimple.Tokens as X diff --git a/src/Tokstyle/Cimple/AST.hs b/src/Language/Cimple/AST.hs similarity index 87% rename from src/Tokstyle/Cimple/AST.hs rename to src/Language/Cimple/AST.hs index 14b2e9d..5251f0e 100644 --- a/src/Tokstyle/Cimple/AST.hs +++ b/src/Language/Cimple/AST.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} -module Tokstyle.Cimple.AST +module Language.Cimple.AST ( AssignOp (..) , BinaryOp (..) , UnaryOp (..) @@ -35,8 +35,11 @@ data Node lexeme | Comment [Node lexeme] | CommentBlock lexeme | CommentWord lexeme - -- extern "C" block + | Commented (Node lexeme) (Node lexeme) + -- Namespace-like blocks | ExternC [Node lexeme] + | Class Scope lexeme [Node lexeme] [Node lexeme] + | Namespace Scope lexeme [Node lexeme] -- Statements | CompoundStmt [Node lexeme] | Break @@ -74,8 +77,11 @@ data Node lexeme | FunctionCall (Node lexeme) [Node lexeme] | CommentExpr (Node lexeme) (Node lexeme) -- Type definitions + | EnumClass lexeme [Node lexeme] + | EnumConsts (Maybe lexeme) [Node lexeme] | EnumDecl lexeme [Node lexeme] lexeme | Enumerator lexeme (Maybe (Node lexeme)) + | ClassForward lexeme [Node lexeme] | Typedef (Node lexeme) lexeme | TypedefFunction (Node lexeme) | Struct lexeme [Node lexeme] @@ -86,12 +92,20 @@ data Node lexeme | TyStruct lexeme | TyFunc lexeme | TyStd lexeme + | TyVar lexeme | TyUserDefined lexeme -- Functions - | FunctionDecl Scope (Node lexeme) + | FunctionDecl Scope (Node lexeme) (Maybe (Node lexeme)) | FunctionDefn Scope (Node lexeme) [Node lexeme] | FunctionPrototype (Node lexeme) lexeme [Node lexeme] | FunctionParam (Node lexeme) (Node lexeme) + | Event lexeme (Node lexeme) + | EventParams [Node lexeme] + | Property (Node lexeme) (Node lexeme) [Node lexeme] + | Accessor lexeme [Node lexeme] (Maybe (Node lexeme)) + | ErrorDecl lexeme [Node lexeme] + | ErrorList [Node lexeme] + | ErrorFor lexeme | Ellipsis -- Constants | ConstDecl (Node lexeme) lexeme diff --git a/src/Tokstyle/Cimple/Diagnostics.hs b/src/Language/Cimple/Diagnostics.hs similarity index 79% rename from src/Tokstyle/Cimple/Diagnostics.hs rename to src/Language/Cimple/Diagnostics.hs index 25f1ad8..83a40e1 100644 --- a/src/Tokstyle/Cimple/Diagnostics.hs +++ b/src/Language/Cimple/Diagnostics.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module Tokstyle.Cimple.Diagnostics (Diagnostics, warn) where +module Language.Cimple.Diagnostics (Diagnostics, warn) where import Control.Monad.State.Lazy (State) import qualified Control.Monad.State.Lazy as State import Data.Text (Text) import qualified Data.Text as Text -import Tokstyle.Cimple.Lexer (Lexeme (..), lexemeLine) +import Language.Cimple.Lexer (Lexeme (..), lexemeLine) type Diagnostics a = State [Text] a diff --git a/src/Tokstyle/Cimple/IO.hs b/src/Language/Cimple/IO.hs similarity index 87% rename from src/Tokstyle/Cimple/IO.hs rename to src/Language/Cimple/IO.hs index b456b51..bc4b8d6 100644 --- a/src/Tokstyle/Cimple/IO.hs +++ b/src/Language/Cimple/IO.hs @@ -1,4 +1,4 @@ -module Tokstyle.Cimple.IO +module Language.Cimple.IO ( parseFile , parseText ) where @@ -11,9 +11,9 @@ import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Tokstyle.Cimple.AST (Node (..)) -import Tokstyle.Cimple.Lexer (Lexeme, runAlex) -import Tokstyle.Cimple.Parser (parseCimple) +import Language.Cimple.AST (Node (..)) +import Language.Cimple.Lexer (Lexeme, runAlex) +import Language.Cimple.Parser (parseCimple) type CompactState a = State (Map String Text) a diff --git a/src/Tokstyle/Cimple/Lexer.x b/src/Language/Cimple/Lexer.x similarity index 92% rename from src/Tokstyle/Cimple/Lexer.x rename to src/Language/Cimple/Lexer.x index e501a9a..0b3f454 100644 --- a/src/Tokstyle/Cimple/Lexer.x +++ b/src/Language/Cimple/Lexer.x @@ -3,7 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} -module Tokstyle.Cimple.Lexer +module Language.Cimple.Lexer ( Alex , AlexPosn (..) , alexError @@ -20,7 +20,7 @@ module Tokstyle.Cimple.Lexer import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Tokstyle.Cimple.Tokens (LexemeClass (..)) +import Language.Cimple.Tokens (LexemeClass (..)) } %wrapper "monad" @@ -42,6 +42,7 @@ tokens :- <0> "WSACleanup" { mkL IdVar } <0> "GetSystemTimeAsFileTime" { mkL IdVar } <0> "GetTickCount" { mkL IdVar } +<0> "SecureZeroMemory" { mkL IdVar } -- Winapi struct members. <0> "GatewayList" { mkL IdVar } @@ -114,27 +115,34 @@ tokens :- <0> "#undef" { mkL PpUndef } <0> "#include" { mkL PpInclude } <0> "#error" { mkL PpError } +<0,ppSC> "bitmask" { mkL KwBitmask } <0,ppSC> "break" { mkL KwBreak } <0,ppSC> "case" { mkL KwCase } +<0,ppSC> "class" { mkL KwClass } <0,ppSC> "const" { mkL KwConst } <0,ppSC> "continue" { mkL KwContinue } <0,ppSC> "default" { mkL KwDefault } <0,ppSC> "do" { mkL KwDo } <0,ppSC> "else" { mkL KwElse } <0,ppSC> "enum" { mkL KwEnum } +<0,ppSC> "error" { mkL KwError } +<0,ppSC> "event" { mkL KwEvent } <0,ppSC> "extern" { mkL KwExtern } <0,ppSC> "for" { mkL KwFor } <0,ppSC> "goto" { mkL KwGoto } <0,ppSC> "if" { mkL KwIf } +<0,ppSC> "namespace" { mkL KwNamespace } <0,ppSC> "return" { mkL KwReturn } <0,ppSC> "sizeof" { mkL KwSizeof } <0,ppSC> "static" { mkL KwStatic } <0,ppSC> "struct" { mkL KwStruct } <0,ppSC> "switch" { mkL KwSwitch } +<0,ppSC> "this" { mkL KwThis } <0,ppSC> "typedef" { mkL KwTypedef } <0,ppSC> "union" { mkL KwUnion } <0,ppSC> "void" { mkL KwVoid } <0,ppSC> "while" { mkL KwWhile } +<0,ppSC> "with" { mkL KwWith } <0,ppSC> "bool" { mkL IdStdType } <0,ppSC> "char" { mkL IdStdType } <0,ppSC> "double" { mkL IdStdType } @@ -146,10 +154,12 @@ tokens :- <0,ppSC> "signed int" { mkL IdStdType } <0,ppSC> "unsigned int" { mkL IdStdType } <0,ppSC> "unsigned long" { mkL IdStdType } +<0,ppSC> "unsigned long long" { mkL IdStdType } <0,ppSC> "unsigned" { mkL IdStdType } <0,ppSC> "va_list" { mkL IdStdType } <0,ppSC> "false" { mkL LitFalse } <0,ppSC> "true" { mkL LitTrue } +<0,ppSC> "`"[a-z]+ { mkL IdTyVar } <0,ppSC> "__func__" { mkL IdVar } <0,ppSC> "__"[a-zA-Z]+"__"? { mkL IdConst } <0,ppSC> [A-Z][A-Z0-9_]{1,2} { mkL IdSueType } @@ -213,14 +223,16 @@ tokens :- "SPDX-License-Identifier:" { mkL CmtSpdxLicense } "GPL-3.0-or-later" { mkL CmtWord } "TODO("[^\)]+"):" { mkL CmtWord } + "@code" { mkL CmtCode `andBegin` codeSC } + "" { mkL CmtCode `andBegin` codeSC } [@\\][a-z]+ { mkL CmtWord } "*"[A-Za-z][A-Za-z0-9_']*"*" { mkL CmtWord } + "#"[A-Za-z][A-Za-z0-9_]* { mkL CmtRef } [A-Za-z][A-Za-z0-9_']* { mkL CmtWord } "#"[0-9]+ { mkL CmtWord } "http://"[^ ]+ { mkL CmtWord } [0-9]+"%" { mkL LitInteger } - "" { mkL CmtCode `andBegin` codeSC } - "`"[^`]+"`" { mkL CmtCode } + "`"([^`]|"\`")+"`" { mkL CmtCode } "*/" { mkL CmtEnd `andBegin` 0 } \n" "+"*/" { mkL CmtEnd `andBegin` 0 } \n" "+"*" { mkL PpNewline } @@ -228,8 +240,9 @@ tokens :- " "+ ; -- blocks in comments. + "@endcode" { mkL CmtCode `andBegin` cmtSC } "" { mkL CmtCode `andBegin` cmtSC } - [^\<]+ { mkL CmtCode } + [^@\<]+ { mkL CmtCode } -- Error handling. <0,ppSC,cmtSC,codeSC> . { mkL Error } diff --git a/src/Tokstyle/Cimple/Parser.y b/src/Language/Cimple/Parser.y similarity index 80% rename from src/Tokstyle/Cimple/Parser.y rename to src/Language/Cimple/Parser.y index 4cb388e..45c8304 100644 --- a/src/Tokstyle/Cimple/Parser.y +++ b/src/Language/Cimple/Parser.y @@ -1,12 +1,12 @@ { -module Tokstyle.Cimple.Parser where +module Language.Cimple.Parser where -import Tokstyle.Cimple.AST (AssignOp (..), BinaryOp (..), +import Language.Cimple.AST (AssignOp (..), BinaryOp (..), LiteralType (..), Node (..), Scope (..), UnaryOp (..)) -import Tokstyle.Cimple.Lexer (Alex, AlexPosn, Lexeme (..), alexError, +import Language.Cimple.Lexer (Alex, AlexPosn, Lexeme (..), alexError, alexMonadScan) -import Tokstyle.Cimple.Tokens (LexemeClass (..)) +import Language.Cimple.Tokens (LexemeClass (..)) } -- Conflict between (static) FunctionDecl and (static) ConstDecl. @@ -22,29 +22,37 @@ import Tokstyle.Cimple.Tokens (LexemeClass (..)) ID_FUNC_TYPE { L _ IdFuncType _ } ID_STD_TYPE { L _ IdStdType _ } ID_SUE_TYPE { L _ IdSueType _ } + ID_TYVAR { L _ IdTyVar _ } ID_VAR { L _ IdVar _ } + bitmask { L _ KwBitmask _ } break { L _ KwBreak _ } case { L _ KwCase _ } + class { L _ KwClass _ } const { L _ KwConst _ } continue { L _ KwContinue _ } default { L _ KwDefault _ } do { L _ KwDo _ } else { L _ KwElse _ } enum { L _ KwEnum _ } + 'error' { L _ KwError _ } + event { L _ KwEvent _ } extern { L _ KwExtern _ } for { L _ KwFor _ } goto { L _ KwGoto _ } if { L _ KwIf _ } + namespace { L _ KwNamespace _ } return { L _ KwReturn _ } sizeof { L _ KwSizeof _ } static { L _ KwStatic _ } struct { L _ KwStruct _ } switch { L _ KwSwitch _ } + this { L _ KwThis _ } typedef { L _ KwTypedef _ } union { L _ KwUnion _ } VLA { L _ KwVla _ } void { L _ KwVoid _ } while { L _ KwWhile _ } + with { L _ KwWith _ } LIT_CHAR { L _ LitChar _ } LIT_FALSE { L _ LitFalse _ } LIT_TRUE { L _ LitTrue _ } @@ -116,6 +124,7 @@ import Tokstyle.Cimple.Tokens (LexemeClass (..)) 'License' { L _ CmtSpdxLicense _ } COMMENT_CODE { L _ CmtCode _ } COMMENT_WORD { L _ CmtWord _ } + COMMENT_REF { L _ CmtRef _ } %left ',' %right '=' '+=' '-=' '*=' '/=' '%=' '<<=' '>>=' '&=' '^=' '|=' @@ -159,6 +168,41 @@ ToplevelDecl | FunctionDecl { $1 } | ConstDecl { $1 } | Comment { $1 } +| Namespace { $1 } +| Event { $1 } +| ErrorDecl { $1 } + +Namespace :: { StringNode } +Namespace +: NamespaceDeclarator { $1 Global } +| static NamespaceDeclarator { $2 Static } + +NamespaceDeclarator :: { Scope -> StringNode } +NamespaceDeclarator +: class ID_SUE_TYPE TypeParams '{' ToplevelDecls '}' { \s -> Class s $2 $3 $5 } +| namespace IdVar '{' ToplevelDecls '}' { \s -> Namespace s $2 $4 } + +TypeParams :: { [StringNode] } +TypeParams +: { [] } +| '<' ID_TYVAR '>' { [TyVar $2] } + +Event :: { StringNode } +Event +: event IdVar '{' EventType '}' { Event $2 $4 } +| event IdVar const '{' EventType '}' { Event $2 $5 } + +EventType :: { StringNode } +EventType +: Comment typedef void EventParams ';' { Commented $1 $4 } + +EventParams :: { StringNode } +EventParams +: FunctionParamList { EventParams $1 } + +ErrorDecl :: { StringNode } +ErrorDecl +: 'error' for IdVar EnumeratorList { ErrorDecl $3 $4 } Comment :: { StringNode } Comment @@ -173,6 +217,7 @@ CommentBody CommentWord :: { StringNode } CommentWord : COMMENT_WORD { CommentWord $1 } +| COMMENT_REF { CommentWord $1 } | COMMENT_CODE { CommentWord $1 } | LIT_INTEGER { CommentWord $1 } | LIT_STRING { CommentWord $1 } @@ -244,7 +289,7 @@ MacroParams MacroParam :: { StringNode } MacroParam -: ID_VAR { MacroParam $1 } +: IdVar { MacroParam $1 } MacroBody :: { StringNode } MacroBody @@ -331,7 +376,7 @@ LabelStmt DeclStmt :: { StringNode } DeclStmt : VarDecl { $1 } -| VLA '(' Type ',' ID_VAR ',' Expr ')' ';' { VLA $3 $5 $7 } +| VLA '(' Type ',' IdVar ',' Expr ')' ';' { VLA $3 $5 $7 } SingleVarDecl :: { StringNode } SingleVarDecl @@ -348,18 +393,25 @@ Declarators Declarator :: { StringNode } Declarator -: DeclSpec(Expr) '=' InitialiserExpr { Declarator $1 (Just $3) } -| DeclSpec(Expr) { Declarator $1 Nothing } +: DeclSpec '=' InitialiserExpr { Declarator $1 (Just $3) } +| DeclSpec { Declarator $1 Nothing } InitialiserExpr :: { StringNode } InitialiserExpr : InitialiserList { InitialiserList $1 } | Expr { $1 } -DeclSpec(expr) -: ID_VAR { DeclSpecVar $1 } -| DeclSpec(expr) '[' ']' { DeclSpecArray $1 Nothing } -| DeclSpec(expr) '[' expr ']' { DeclSpecArray $1 (Just $3) } +DeclSpec :: { StringNode } +DeclSpec +: IdVar { DeclSpecVar $1 } +| DeclSpec '[' ']' { DeclSpecArray $1 Nothing } +| DeclSpec '[' Expr ']' { DeclSpecArray $1 (Just $3) } + +IdVar :: { Lexeme String } +IdVar +: ID_VAR { $1 } +| default { $1 } +| 'error' { $1 } InitialiserList :: { [StringNode] } InitialiserList @@ -451,10 +503,10 @@ ExprStmt LhsExpr :: { StringNode } LhsExpr -: ID_VAR { VarExpr $1 } +: IdVar { VarExpr $1 } | '*' LhsExpr %prec DEREF { UnaryExpr UopDeref $2 } -| LhsExpr '.' ID_VAR { MemberAccess $1 $3 } -| LhsExpr '->' ID_VAR { PointerAccess $1 $3 } +| LhsExpr '.' IdVar { MemberAccess $1 $3 } +| LhsExpr '->' IdVar { PointerAccess $1 $3 } | LhsExpr '[' Expr ']' { ArrayAccess $1 $3 } FunctionCall :: { StringNode } @@ -478,7 +530,11 @@ Arg EnumDecl :: { StringNode } EnumDecl -: typedef enum ID_SUE_TYPE EnumeratorList ID_SUE_TYPE ';' { EnumDecl $3 $4 $5 } +: enum class ID_SUE_TYPE EnumeratorList { EnumClass $3 $4 } +| enum ID_SUE_TYPE EnumeratorList { EnumConsts (Just $2) $3 } +| enum EnumeratorList ';' { EnumConsts Nothing $2 } +| typedef enum ID_SUE_TYPE EnumeratorList ID_SUE_TYPE ';' { EnumDecl $3 $4 $5 } +| bitmask ID_SUE_TYPE EnumeratorList { EnumDecl $2 $3 $2 } EnumeratorList :: { [StringNode] } EnumeratorList @@ -491,18 +547,26 @@ Enumerators Enumerator :: { StringNode } Enumerator -: ID_CONST ',' { Enumerator $1 Nothing } -| ID_CONST '=' ConstExpr ',' { Enumerator $1 (Just $3) } +: EnumeratorName ',' { Enumerator $1 Nothing } +| EnumeratorName '=' ConstExpr ',' { Enumerator $1 (Just $3) } +| namespace ID_CONST '{' Enumerators '}' { Namespace Global $2 $4 } | Comment { $1 } +EnumeratorName :: { Lexeme String } +EnumeratorName +: ID_CONST { $1 } +| ID_SUE_TYPE { $1 } + AggregateDecl :: { StringNode } AggregateDecl : AggregateType ';' { $1 } +| class ID_SUE_TYPE TypeParams ';' { ClassForward $2 $3 } | typedef AggregateType ID_SUE_TYPE ';' { Typedef $2 $3 } AggregateType :: { StringNode } AggregateType : struct ID_SUE_TYPE '{' MemberDecls '}' { Struct $2 $4 } +| struct this '{' MemberDecls '}' { Struct $2 $4 } | union ID_SUE_TYPE '{' MemberDecls '}' { Union $2 $4 } MemberDecls :: { [StringNode] } @@ -512,8 +576,9 @@ MemberDecls MemberDecl :: { StringNode } MemberDecl -: QualType DeclSpec(ConstExpr) ';' { MemberDecl $1 $2 Nothing } -| QualType DeclSpec(ConstExpr) ':' LIT_INTEGER ';' { MemberDecl $1 $2 (Just $4) } +: QualType DeclSpec ';' { MemberDecl $1 $2 Nothing } +| QualType DeclSpec ':' LIT_INTEGER ';' { MemberDecl $1 $2 (Just $4) } +| namespace IdVar '{' MemberDecls '}' { Namespace Global $2 $4 } | PreprocIfdef(MemberDecls) { $1 } | Comment { $1 } @@ -537,9 +602,11 @@ LeafType :: { StringNode } LeafType : struct ID_SUE_TYPE { TyStruct $2 } | void { TyStd $1 } +| this { TyStd $1 } | ID_FUNC_TYPE { TyFunc $1 } | ID_STD_TYPE { TyStd $1 } | ID_SUE_TYPE { TyUserDefined $1 } +| ID_TYVAR { TyVar $1 } FunctionDecl :: { StringNode } FunctionDecl @@ -548,15 +615,34 @@ FunctionDecl FunctionDeclarator :: { Scope -> StringNode } FunctionDeclarator -: FunctionPrototype(ID_VAR) ';' { \s -> FunctionDecl s $1 } -| FunctionPrototype(ID_VAR) CompoundStmt { \s -> FunctionDefn s $1 $2 } +: FunctionPrototype(IdVar) WithError { \s -> FunctionDecl s $1 $2 } +| FunctionPrototype(IdVar) CompoundStmt { \s -> FunctionDefn s $1 $2 } +| QualType DeclSpec '{' Accessors '}' { \s -> Property $1 $2 $4 } + +Accessors :: { [StringNode] } +Accessors +: Accessor { [$1] } +| Accessors Accessor { $2 : $1 } + +Accessor :: { StringNode } +Accessor +: IdVar FunctionParamList WithError { Accessor $1 $2 $3 } +| Comment { $1 } + +WithError :: { Maybe StringNode } +WithError +: ';' { Nothing } +| with 'error' EnumeratorList { Just (ErrorList $3) } +| with 'error' for IdVar ';' { Just (ErrorFor $4) } FunctionPrototype(id) : QualType id FunctionParamList { FunctionPrototype $1 $2 $3 } +| QualType id FunctionParamList const { FunctionPrototype $1 $2 $3 } FunctionParamList :: { [StringNode] } FunctionParamList -: '(' void ')' { [] } +: '(' ')' { [] } +| '(' void ')' { [TyStd $2] } | '(' FunctionParams ')' { reverse $2 } | '(' FunctionParams ',' '...' ')' { reverse $ Ellipsis : $2 } @@ -567,7 +653,7 @@ FunctionParams FunctionParam :: { StringNode } FunctionParam -: QualType DeclSpec(ConstExpr) { FunctionParam $1 $2 } +: QualType DeclSpec { FunctionParam $1 $2 } ConstDecl :: { StringNode } ConstDecl diff --git a/src/Tokstyle/Cimple/Tokens.hs b/src/Language/Cimple/Tokens.hs similarity index 92% rename from src/Tokstyle/Cimple/Tokens.hs rename to src/Language/Cimple/Tokens.hs index f5adf38..0453899 100644 --- a/src/Tokstyle/Cimple/Tokens.hs +++ b/src/Language/Cimple/Tokens.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} -module Tokstyle.Cimple.Tokens +module Language.Cimple.Tokens ( LexemeClass (..) ) where @@ -11,29 +11,37 @@ data LexemeClass | IdFuncType | IdStdType | IdSueType + | IdTyVar | IdVar + | KwBitmask | KwBreak | KwCase + | KwClass | KwConst | KwContinue | KwDefault | KwDo - | KwFor - | KwGoto - | KwIf | KwElse | KwEnum + | KwError + | KwEvent | KwExtern + | KwFor + | KwGoto + | KwIf + | KwNamespace | KwReturn | KwSizeof | KwStatic | KwStruct | KwSwitch + | KwThis | KwTypedef | KwUnion | KwVla | KwVoid | KwWhile + | KwWith | LitFalse | LitTrue | LitChar @@ -104,6 +112,7 @@ data LexemeClass | CmtSpdxLicense | CmtCode | CmtWord + | CmtRef | CmtEnd | Error diff --git a/src/Tokstyle/Cimple/TraverseAst.hs b/src/Language/Cimple/TraverseAst.hs similarity index 84% rename from src/Tokstyle/Cimple/TraverseAst.hs rename to src/Language/Cimple/TraverseAst.hs index 7eee06a..a1328e4 100644 --- a/src/Tokstyle/Cimple/TraverseAst.hs +++ b/src/Language/Cimple/TraverseAst.hs @@ -2,15 +2,15 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -module Tokstyle.Cimple.TraverseAst +module Language.Cimple.TraverseAst ( TraverseAst (..) , AstActions (..) , defaultActions ) where import Data.Text (Text) -import Tokstyle.Cimple.AST (Node (..)) -import Tokstyle.Cimple.Lexer (Lexeme (..)) +import Language.Cimple.AST (Node (..)) +import Language.Cimple.Lexer (Lexeme (..)) class TraverseAst a where traverseAst :: Applicative f => AstActions f Text -> a -> f a @@ -90,6 +90,8 @@ instance TraverseAst (Node (Lexeme Text)) where CommentBlock <$> recurse comment CommentWord word -> CommentWord <$> recurse word + Commented comment node -> + Commented <$> recurse comment <*> recurse node ExternC decls -> ExternC <$> recurse decls CompoundStmt stmts -> @@ -158,6 +160,10 @@ instance TraverseAst (Node (Lexeme Text)) where FunctionCall <$> recurse callee <*> recurse args CommentExpr comment expr -> CommentExpr <$> recurse comment <*> recurse expr + EnumClass name members -> + EnumClass <$> recurse name <*> recurse members + EnumConsts name members -> + EnumConsts <$> recurse name <*> recurse members EnumDecl name members tyName -> EnumDecl <$> recurse name <*> recurse members <*> recurse tyName Enumerator name value -> @@ -166,6 +172,12 @@ instance TraverseAst (Node (Lexeme Text)) where Typedef <$> recurse ty <*> recurse name TypedefFunction ty -> TypedefFunction <$> recurse ty + Namespace scope name members -> + Namespace scope <$> recurse name <*> recurse members + Class scope name tyvars members -> + Class scope <$> recurse name <*> recurse tyvars <*> recurse members + ClassForward name tyvars -> + ClassForward <$> recurse name <*> recurse tyvars Struct name members -> Struct <$> recurse name <*> recurse members Union name members -> @@ -180,18 +192,34 @@ instance TraverseAst (Node (Lexeme Text)) where TyStruct <$> recurse name TyFunc name -> TyFunc <$> recurse name + TyVar name -> + TyVar <$> recurse name TyStd name -> TyStd <$> recurse name TyUserDefined name -> TyUserDefined <$> recurse name - FunctionDecl scope proto -> - FunctionDecl scope <$> recurse proto + FunctionDecl scope proto errors -> + FunctionDecl scope <$> recurse proto <*> recurse errors FunctionDefn scope proto body -> FunctionDefn scope <$> recurse proto <*> recurse body FunctionPrototype ty name params -> FunctionPrototype <$> recurse ty <*> recurse name <*> recurse params FunctionParam ty decl -> FunctionParam <$> recurse ty <*> recurse decl + Event name params -> + Event <$> recurse name <*> recurse params + EventParams params -> + EventParams <$> recurse params + Property ty decl accessors -> + Property <$> recurse ty <*> recurse decl <*> recurse accessors + Accessor name params errors -> + Accessor <$> recurse name <*> recurse params <*> recurse errors + ErrorDecl name errors -> + ErrorDecl <$> recurse name <*> recurse errors + ErrorList errors -> + ErrorList <$> recurse errors + ErrorFor name -> + ErrorFor <$> recurse name Ellipsis -> pure Ellipsis ConstDecl ty name -> diff --git a/src/Tokstyle/C.hs b/src/Tokstyle/C.hs deleted file mode 100644 index 9307b67..0000000 --- a/src/Tokstyle/C.hs +++ /dev/null @@ -1,72 +0,0 @@ -module Tokstyle.C (main) where - -import Control.Applicative ((<$>)) -import qualified Data.List as List -import Language.C (CError, CTranslUnit, - ErrorInfo (..), InputStream, - errorInfo, initPos, parseC, - posFile, posRow) -import Language.C.Analysis.AstAnalysis (analyseAST) -import Language.C.Analysis.SemRep (GlobalDecls) -import Language.C.Analysis.TravMonad (runTrav_) -import Language.C.System.GCC (newGCC) -import Language.C.System.Preprocess (rawCppArgs, runPreprocessor) -import System.Environment (getArgs) - -import qualified Tokstyle.C.Naming -import Tokstyle.Result - - -phaseCpp :: FilePath -> IO InputStream -phaseCpp file = do - cppArgs <- (["-std=c99", "-U__BLOCKS__", "-D_VA_LIST", "-D_Nonnull=", "-D_Nullable=", "-D__attribute__(x)="] ++) <$> getArgs - result <- runPreprocessor (newGCC "gcc") $ rawCppArgs cppArgs file - case result of - Left err -> fail $ show err - Right ok -> return ok - - -phaseParse :: FilePath -> InputStream -> Result CTranslUnit -phaseParse file preprocessed = - case parseC preprocessed (initPos file) of - Left err -> fail $ show err - Right tu -> return tu - - -phaseAnalyse :: CTranslUnit -> Result (CTranslUnit, GlobalDecls, [CError]) -phaseAnalyse tu = - case runTrav_ (analyseAST tu) of - Left errs -> fail $ concatMap show errs - Right (decls, cerr) -> return (tu, decls, cerr) - - -phaseCheck :: (CTranslUnit, GlobalDecls, [CError]) -> [CError] -phaseCheck (tu, decls, _cerr) = - --cerr ++ - Tokstyle.C.Naming.check tu decls - - -printError :: ErrorInfo -> IO () -printError (ErrorInfo _ pos msgs) = - putStrLn $ file ++ ":" ++ show line ++ ": " ++ List.intercalate "\n\t" msgs - where - file = posFile pos - line = posRow pos - - -showResult :: Result [CError] -> IO () -showResult (Success cerr) = mapM_ (printError . errorInfo) cerr -showResult (Failure err) = putStr err - - -process :: FilePath -> IO () -process path = do - preprocessed <- phaseCpp path - let analysis = phaseParse path preprocessed >>= phaseAnalyse - let results = phaseCheck <$> analysis - showResult results - -main :: [String] -> IO () -main sources = do - putStrLn "[=] preprocessing..." - mapM_ process sources diff --git a/src/Tokstyle/C/Naming.hs b/src/Tokstyle/C/Naming.hs deleted file mode 100644 index 6d8d6eb..0000000 --- a/src/Tokstyle/C/Naming.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -module Tokstyle.C.Naming where - -import qualified Data.Char as Char -import qualified Data.List as List -import Language.C -import Language.C.Analysis.SemRep -import Language.C.Data.Ident -import System.FilePath - - -getSrcFile :: NodeInfo -> String -getSrcFile (OnlyPos _ (pos, _) ) = posFile pos -getSrcFile (NodeInfo _ (pos, _) _) = posFile pos - - -toLower :: String -> String -toLower = map Char.toLower - - -check :: CTranslUnit -> GlobalDecls -> [CError] -check (CTranslUnit edecls ni) _ = - reverse . map (CError . mkNamingError) . foldl globalNamesCED [] $ edecls - where - srcFile = getSrcFile ni - namespace = - case toLower . takeFileName . dropExtension $ srcFile of - "audio" -> "ac" - "bwcontroller" -> "bwc" - "list" -> "bs_list" - "messenger" -> "m" - "network" -> "net" - "onion_announce" -> "onion" - "onion_client" -> "onion" - "ring_buffer" -> "rb" - "video" -> "vc" - ns -> ns - - mkNamingError (Ident name _ nameNi) = - mkErrorInfo LevelWarn name nameNi - - globalNamesCED names (CDeclExt cde) = - globalNamesCDE names cde - globalNamesCED names (CFDefExt cfde) = - globalNamesCFDE names cfde - globalNamesCED names _ = names - - globalNamesCFDE names (CFunDef declspec dcl _ _ _) = - if isGlobal declspec - then globalNamesCDR names dcl - else names - - globalNamesCDE names (CDecl declspec dcls _) = - if isGlobal declspec - then foldl globalNamesCDL names dcls - else names - globalNamesCDE names _ = names - - globalNamesCDL names (Just cdr, _, _) = - globalNamesCDR names cdr - globalNamesCDL names _ = names - - globalNamesCDR names (CDeclr (Just name) _ _ _ nameNi) = - if getSrcFile nameNi == srcFile - && (violatesNamingScheme . toLower . identToString $ name) - then name : names - else names - globalNamesCDR names _ = names - - isGlobal = all $ \case - CStorageSpec (CStatic _) -> False - _ -> True - - violatesNamingScheme name = - not ( - name == namespace || - List.isPrefixOf (namespace ++ "_") name - ) diff --git a/src/Tokstyle/Cimple/Analysis.hs b/src/Tokstyle/Cimple/Analysis.hs deleted file mode 100644 index 3497ca3..0000000 --- a/src/Tokstyle/Cimple/Analysis.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Tokstyle.Cimple.Analysis (analyse) where - -import Data.Text (Text) -import Tokstyle.Cimple.AST (Node (..)) -import Tokstyle.Cimple.Lexer (Lexeme) - -import qualified Tokstyle.Cimple.Analysis.FuncScopes as FuncScopes -import qualified Tokstyle.Cimple.Analysis.GlobalFuncs as GlobalFuncs -import qualified Tokstyle.Cimple.Analysis.LoggerCalls as LoggerCalls -import qualified Tokstyle.Cimple.Analysis.LoggerNoEscapes as LoggerNoEscapes - -analyse :: FilePath -> [Node (Lexeme Text)] -> [Text] -analyse file ast = concatMap (\f -> f file ast) - [ FuncScopes.analyse - , GlobalFuncs.analyse - , LoggerCalls.analyse - , LoggerNoEscapes.analyse - ] diff --git a/src/Tokstyle/Cimple/Analysis/FuncScopes.hs b/src/Tokstyle/Cimple/Analysis/FuncScopes.hs deleted file mode 100644 index 53a5a2d..0000000 --- a/src/Tokstyle/Cimple/Analysis/FuncScopes.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tokstyle.Cimple.Analysis.FuncScopes (analyse) where - -import Control.Monad (foldM, when) -import qualified Control.Monad.State.Lazy as State -import Data.Text (Text) -import qualified Data.Text as Text -import Tokstyle.Cimple.AST (Node (..), Scope (..)) -import Tokstyle.Cimple.Diagnostics (warn) -import Tokstyle.Cimple.Lexer (Lexeme (..), lexemeLine, - lexemeText) - - -analyse :: FilePath -> [Node (Lexeme Text)] -> [Text] -analyse file ast = reverse $ snd $ State.runState (foldM go [] ast) [] - where - go decls (FunctionDecl declScope (FunctionPrototype _ name _)) = - return $ (lexemeText name, (name, declScope)) : decls - go decls (FunctionDefn defnScope (FunctionPrototype _ name _) _) = - case lookup (lexemeText name) decls of - Nothing -> return decls - Just (decl, declScope) -> do - when (declScope /= defnScope) $ warn file name $ - warning decl declScope defnScope - return decls - go decls _ = return decls - - warning decl declScope defnScope = - "function definition `" <> lexemeText decl - <> "' does not agree with its declaration about scope: " - <> "declaration on line " <> Text.pack (show (lexemeLine decl)) - <> " is " <> scopeKeyword declScope <> " but definition is " - <> scopeKeyword defnScope - - scopeKeyword Global = "extern" - scopeKeyword Static = "static" diff --git a/src/Tokstyle/Cimple/Analysis/GlobalFuncs.hs b/src/Tokstyle/Cimple/Analysis/GlobalFuncs.hs deleted file mode 100644 index 1e5c56c..0000000 --- a/src/Tokstyle/Cimple/Analysis/GlobalFuncs.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tokstyle.Cimple.Analysis.GlobalFuncs (analyse) where - -import qualified Control.Monad.State.Lazy as State -import Data.Text (Text) -import System.FilePath (takeExtension) -import Tokstyle.Cimple.AST (Node (..), Scope (..)) -import Tokstyle.Cimple.Diagnostics (warn) -import Tokstyle.Cimple.Lexer (Lexeme (..), lexemeText) - - -analyse :: FilePath -> [Node (Lexeme Text)] -> [Text] -analyse file _ | takeExtension file /= ".c" = [] -analyse file ast = reverse $ snd $ State.runState (mapM go ast) [] - where - go (FunctionDecl Global (FunctionPrototype _ name _)) = - warn file name $ - "global function `" <> lexemeText name <> "' declared in .c file" - go _ = return () diff --git a/src/Tokstyle/Cimple/Analysis/LoggerCalls.hs b/src/Tokstyle/Cimple/Analysis/LoggerCalls.hs deleted file mode 100644 index d5d74fc..0000000 --- a/src/Tokstyle/Cimple/Analysis/LoggerCalls.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tokstyle.Cimple.Analysis.LoggerCalls (analyse) where - -import Control.Monad.State.Lazy (State) -import qualified Control.Monad.State.Lazy as State -import Data.Text (Text) -import qualified Data.Text as Text -import System.FilePath (takeFileName) -import Tokstyle.Cimple.AST (LiteralType (String), Node (..)) -import qualified Tokstyle.Cimple.Diagnostics as Diagnostics -import Tokstyle.Cimple.Lexer (Lexeme (..)) -import Tokstyle.Cimple.TraverseAst - - -linter :: FilePath -> AstActions (State [Text]) Text -linter file = defaultActions - { doNode = \node act -> - case node of - -- Ignore all function calls where the second argument is a string - -- literal. If it's a logger call, it's a valid one. - FunctionCall _ (_:LiteralExpr String _:_) -> act - -- LOGGER_ASSERT has its format as the third parameter. - FunctionCall (LiteralExpr _ (L _ _ "LOGGER_ASSERT")) (_:_:LiteralExpr String _:_) -> act - - FunctionCall (LiteralExpr _ name@(L _ _ func)) _ | Text.isPrefixOf "LOGGER_" func -> do - warn name $ "logger call `" <> func <> "' has a non-literal format argument" - act - - _ -> act - } - where warn = Diagnostics.warn file - - -analyse :: FilePath -> [Node (Lexeme Text)] -> [Text] --- Ignore logger.h, which contains a bunch of macros that call LOGGER functions --- with their (literal) arguments. We don't know that they are literals at this --- point, though. -analyse file _ | takeFileName file == "logger.h" = [] -analyse file ast = reverse $ State.execState (traverseAst (linter file) ast) [] diff --git a/src/Tokstyle/Cimple/Analysis/LoggerNoEscapes.hs b/src/Tokstyle/Cimple/Analysis/LoggerNoEscapes.hs deleted file mode 100644 index 923560e..0000000 --- a/src/Tokstyle/Cimple/Analysis/LoggerNoEscapes.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tokstyle.Cimple.Analysis.LoggerNoEscapes (analyse) where - -import Control.Monad (when) -import Control.Monad.State.Lazy (State) -import qualified Control.Monad.State.Lazy as State -import Data.Text (Text, isInfixOf) -import qualified Data.Text as Text -import Tokstyle.Cimple.AST (LiteralType (String), Node (..)) -import qualified Tokstyle.Cimple.Diagnostics as Diagnostics -import Tokstyle.Cimple.Lexer (Lexeme (..), lexemeText) -import Tokstyle.Cimple.TraverseAst - - -linter :: FilePath -> AstActions (State [Text]) Text -linter file = defaultActions - { doNode = \node act -> case node of - -- LOGGER_ASSERT has its format as the third parameter. - FunctionCall (LiteralExpr _ (L _ _ "LOGGER_ASSERT")) (_ : _ : LiteralExpr String fmt : _) - -> do - checkFormat file fmt - act - - FunctionCall (LiteralExpr _ (L _ _ func)) (_ : LiteralExpr String fmt : _) - | Text.isPrefixOf "LOGGER_" func - -> do - checkFormat file fmt - act - - _ -> act - } - - -checkFormat :: FilePath -> Lexeme Text -> State [Text] () -checkFormat file fmt = - when ("\\" `isInfixOf` text) - $ Diagnostics.warn file fmt - $ "logger format " - <> text - <> " contains escape sequences (newlines, tabs, or escaped quotes)" - where text = lexemeText fmt - - -analyse :: FilePath -> [Node (Lexeme Text)] -> [Text] -analyse file ast = reverse $ State.execState (traverseAst (linter file) ast) [] diff --git a/src/Tokstyle/Result.hs b/src/Tokstyle/Result.hs deleted file mode 100644 index cbd31e2..0000000 --- a/src/Tokstyle/Result.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE Safe #-} -module Tokstyle.Result where - -import Control.Applicative (Applicative (..)) -import Control.DeepSeq (NFData) -import GHC.Generics (Generic) - - -data Result a - = Success a - | Failure String - deriving (Read, Show, Eq, Functor, Generic) - -instance NFData a => NFData (Result a) - - -instance Applicative Result where - pure = Success - - Success f <*> x = fmap f x - Failure msg <*> _ = Failure msg - - -instance Monad Result where - return = pure - fail = Failure - - Success x >>= f = f x - Failure msg >>= _ = Failure msg diff --git a/src/Tokstyle/Sources.hs b/src/Tokstyle/Sources.hs deleted file mode 100644 index f30a816..0000000 --- a/src/Tokstyle/Sources.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Tokstyle.Sources (sources) where - -sources :: [String] -sources = map ("../c-toxcore/" ++) - [ "toxav/audio.c" - , "toxav/audio.h" - , "toxav/bwcontroller.c" - , "toxav/bwcontroller.h" - , "toxav/groupav.c" - , "toxav/groupav.h" - , "toxav/msi.c" - , "toxav/msi.h" - , "toxav/rtp.c" - , "toxav/rtp.h" - , "toxav/toxav.c" - , "toxav/toxav_old.c" - , "toxav/video.c" - , "toxav/video.h" - , "toxcore/DHT.c" - , "toxcore/DHT.h" - , "toxcore/LAN_discovery.c" - , "toxcore/LAN_discovery.h" - , "toxcore/Messenger.c" - , "toxcore/Messenger.h" - , "toxcore/TCP_client.c" - , "toxcore/TCP_client.h" - , "toxcore/TCP_connection.c" - , "toxcore/TCP_connection.h" - , "toxcore/TCP_server.c" - , "toxcore/TCP_server.h" - , "toxcore/crypto_core.c" - , "toxcore/crypto_core.h" - , "toxcore/friend_connection.c" - , "toxcore/friend_connection.h" - , "toxcore/friend_requests.c" - , "toxcore/friend_requests.h" - , "toxcore/group.c" - , "toxcore/group.h" - , "toxcore/list.c" - , "toxcore/list.h" - , "toxcore/logger.c" - , "toxcore/logger.h" - , "toxcore/mono_time.c" - , "toxcore/mono_time.h" - , "toxcore/network.c" - , "toxcore/network.h" - , "toxcore/net_crypto.c" - , "toxcore/net_crypto.h" - , "toxcore/onion.c" - , "toxcore/onion.h" - , "toxcore/onion_announce.c" - , "toxcore/onion_announce.h" - , "toxcore/onion_client.c" - , "toxcore/onion_client.h" - , "toxcore/ping.c" - , "toxcore/ping.h" - , "toxcore/ping_array.c" - {-, "toxcore/ping_array.h"-} - , "toxcore/state.c" - , "toxcore/state.h" - , "toxcore/tox.c" - {-, "toxcore/tox.h"-} - , "toxcore/util.c" - , "toxcore/util.h" - ] diff --git a/stack.yaml b/stack.yaml index f3a6a2c..207ae92 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,6 @@ --- packages: [.] resolver: lts-14.27 +extra-deps: + - msgpack-binary-0.0.14@sha256:46c3cf9090ad07d45c79cb74a94c05548ce9f2b5e9d78a497de80ceb5bf55014,2383 + - msgpack-types-0.0.4@sha256:3b045ea90ba9ba62de9538aa7e7915d1356e2cc34ebdb02f4472ee5b981bcab7,1940 diff --git a/test/Language/CimpleSpec.hs b/test/Language/CimpleSpec.hs new file mode 100644 index 0000000..4de3339 --- /dev/null +++ b/test/Language/CimpleSpec.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.CimpleSpec where + +import Test.Hspec (Spec, describe, it, shouldBe) + +import Language.Cimple (AlexPosn (..), Lexeme (..), + LexemeClass (..), LiteralType (..), + Node (..), Scope (..)) +import Language.Cimple.IO (parseText) + + +spec :: Spec +spec = + describe "C parsing" $ do + it "should parse a simple function" $ do + ast <- parseText "int a(void) { return 3; }" + ast `shouldBe` Right + [ FunctionDefn + Global + (FunctionPrototype + (TyStd (L (AlexPn 0 1 1) IdStdType "int")) + (L (AlexPn 4 1 5) IdVar "a") + [TyStd (L (AlexPn 6 1 7) KwVoid "void")] + ) + [ Return + (Just + (LiteralExpr + Int + (L (AlexPn 21 1 22) LitInteger "3") + ) + ) + ] + ] + + it "should parse a type declaration" $ do + ast <- parseText "typedef struct Foo { int x; } Foo;" + ast `shouldBe` Right + [ Typedef + (Struct + (L (AlexPn 15 1 16) IdSueType "Foo") + [ MemberDecl + (TyStd (L (AlexPn 21 1 22) IdStdType "int")) + (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")) + Nothing + ] + ) + (L (AlexPn 30 1 31) IdSueType "Foo") + ] + + it "should parse a struct with bit fields" $ do + ast <- parseText "typedef struct Foo { int x : 123; } Foo;" + ast `shouldBe` Right + [ Typedef + (Struct + (L (AlexPn 15 1 16) IdSueType "Foo") + [ MemberDecl + (TyStd (L (AlexPn 21 1 22) IdStdType "int")) + (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")) + (Just (L (AlexPn 29 1 30) LitInteger "123")) + ] + ) + (L (AlexPn 36 1 37) IdSueType "Foo") + ] + + it "should parse a comment" $ do + ast <- parseText "/* hello */" + ast `shouldBe` Right + [Comment [CommentWord (L (AlexPn 3 1 4) CmtWord "hello")]] diff --git a/test/Tokstyle/CimpleSpec.hs b/test/Tokstyle/CimpleSpec.hs deleted file mode 100644 index 90d1e8e..0000000 --- a/test/Tokstyle/CimpleSpec.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tokstyle.CimpleSpec where - -import Test.Hspec (Spec, describe, it, shouldBe) - -import Tokstyle.Cimple.AST (LiteralType (..), Node (..), - Scope (..)) -import Tokstyle.Cimple.Lexer (AlexPosn (..), Lexeme (..), runAlex) -import Tokstyle.Cimple.Parser (parseCimple) -import Tokstyle.Cimple.Tokens (LexemeClass (..)) - - -spec :: Spec -spec = - describe "C parsing" $ do - it "should parse a simple function" $ do - let ast = runAlex "int a(void) { return 3; }" parseCimple - ast `shouldBe` Right [ - FunctionDefn - Global - (FunctionPrototype - (TyStd (L (AlexPn 0 1 1) IdStdType "int")) - (L (AlexPn 4 1 5) IdVar "a") - []) - [Return (Just (LiteralExpr Int (L (AlexPn 21 1 22) LitInteger "3")))]] - - it "should parse a type declaration" $ do - let ast = runAlex "typedef struct Foo { int x; } Foo;" parseCimple - ast `shouldBe` Right [ - Typedef ( - Struct (L (AlexPn 15 1 16) IdSueType "Foo") - [MemberDecl - (TyStd (L (AlexPn 21 1 22) IdStdType "int")) - (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")) - Nothing]) - (L (AlexPn 30 1 31) IdSueType "Foo")] - - it "should parse a struct with bit fields" $ do - let ast = runAlex "typedef struct Foo { int x : 123; } Foo;" parseCimple - ast `shouldBe` Right [ - Typedef ( - Struct - (L (AlexPn 15 1 16) IdSueType "Foo") - [MemberDecl - (TyStd (L (AlexPn 21 1 22) IdStdType "int")) - (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")) - (Just (L (AlexPn 29 1 30) LitInteger "123"))]) - (L (AlexPn 36 1 37) IdSueType "Foo")] - - it "should parse a comment" $ do - let ast = runAlex "/* hello */" parseCimple - ast `shouldBe` Right [ - Comment [CommentWord (L (AlexPn 3 1 4) CmtWord "hello")]] diff --git a/tokstyle.cabal b/tokstyle.cabal deleted file mode 100644 index 8505e95..0000000 --- a/tokstyle.cabal +++ /dev/null @@ -1,126 +0,0 @@ -name: tokstyle -version: 0.0.5 -synopsis: TokTok C code style checker -description: TokTok C code style checker -homepage: https://toktok.github.io/tokstyle -license: GPL-3 -license-file: LICENSE -author: iphydf -maintainer: iphydf@users.noreply.github.com -category: Development -build-type: Simple -cabal-version: >=1.10 - -source-repository head - type: git - location: https://github.com/TokTok/tokstyle - -library - default-language: Haskell2010 - exposed-modules: - Tokstyle.C - , Tokstyle.Cimple.Analysis - , Tokstyle.Cimple.Analysis.FuncScopes - , Tokstyle.Cimple.Analysis.GlobalFuncs - , Tokstyle.Cimple.Analysis.LoggerCalls - , Tokstyle.Cimple.Analysis.LoggerNoEscapes - , Tokstyle.Cimple.AST - , Tokstyle.Cimple.Diagnostics - , Tokstyle.Cimple.IO - , Tokstyle.Cimple.Lexer - , Tokstyle.Cimple.Parser - , Tokstyle.Cimple.Tokens - , Tokstyle.Cimple.TraverseAst - , Tokstyle.Sources - other-modules: - Tokstyle.C.Naming - , Tokstyle.Result - ghc-options: - -Wall - hs-source-dirs: src - build-depends: - base >= 4 && < 5 - , aeson >= 0.8.1.0 - , array - , bytestring - , containers - , compact - , deepseq - , filepath - , groom - , language-c - , mtl - , text - -executable check-c - default-language: Haskell2010 - hs-source-dirs: - tools - ghc-options: - -Wall - main-is: check-c.hs - build-depends: - base < 5 - , tokstyle - -executable check-cimple - default-language: Haskell2010 - hs-source-dirs: - tools - ghc-options: - -Wall - main-is: check-cimple.hs - build-depends: - base < 5 - , text - , tokstyle - , text - -executable dump-tokens - default-language: Haskell2010 - hs-source-dirs: - tools - ghc-options: - -Wall - main-is: dump-tokens.hs - build-depends: - base < 5 - , bytestring - , groom - , tokstyle - , text - -executable webservice - main-is: webservice.hs - ghc-options: - -Wall - hs-source-dirs: web - default-language: Haskell2010 - other-modules: - Tokstyle.App - build-depends: - base >= 4 && < 5 - , bytestring - , servant >= 0.5 - , servant-server >= 0.5 - , text - , tokstyle - , wai - , wai-cors - , wai-extra - , warp - -test-suite testsuite - type: exitcode-stdio-1.0 - default-language: Haskell2010 - hs-source-dirs: test - main-is: testsuite.hs - other-modules: - Tokstyle.CimpleSpec - ghc-options: - -Wall - -fno-warn-unused-imports - build-depends: - base < 5 - , tokstyle - , hspec diff --git a/tools/BUILD.bazel b/tools/BUILD.bazel index cf81a81..4f3e06e 100644 --- a/tools/BUILD.bazel +++ b/tools/BUILD.bazel @@ -2,23 +2,14 @@ load("@ai_formation_hazel//tools:mangling.bzl", "hazel_library") load("@rules_haskell//haskell:defs.bzl", "haskell_binary") haskell_binary( - name = "check-c", - srcs = ["check-c.hs"], + name = "dump-ast", + srcs = ["dump-ast.hs"], visibility = ["//visibility:public"], deps = [ - "//hs-tokstyle", + "//hs-cimple", hazel_library("base"), - ], -) - -haskell_binary( - name = "check-cimple", - srcs = ["check-cimple.hs"], - visibility = ["//visibility:public"], - deps = [ - "//hs-tokstyle", - hazel_library("base"), - hazel_library("text"), + hazel_library("bytestring"), + hazel_library("groom"), ], ) @@ -27,7 +18,7 @@ haskell_binary( srcs = ["dump-tokens.hs"], visibility = ["//visibility:public"], deps = [ - "//hs-tokstyle", + "//hs-cimple:lexer", hazel_library("base"), hazel_library("bytestring"), hazel_library("groom"), diff --git a/tools/check-c.hs b/tools/check-c.hs deleted file mode 100644 index a5b9996..0000000 --- a/tools/check-c.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main (main) where - -import qualified Tokstyle.C -import Tokstyle.Sources (sources) - -main :: IO () -main = Tokstyle.C.main sources diff --git a/tools/check-cimple.hs b/tools/check-cimple.hs deleted file mode 100644 index ba5c996..0000000 --- a/tools/check-cimple.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main (main) where - -import qualified Data.Text.IO as Text -import System.Environment (getArgs) -import Tokstyle.Cimple.IO (parseFile) -import Tokstyle.Sources (sources) - -import Tokstyle.Cimple.Analysis (analyse) - - -processFile :: FilePath -> IO () -processFile file = do - ast <- parseFile file >>= getRight - case analyse file ast of - [] -> return () - diags -> do - mapM_ Text.putStrLn diags - fail $ "errors found in " <> file - where - getRight (Left err) = fail err - getRight (Right ok) = return ok - - -main :: IO () -main = do - args <- getArgs - mapM_ processFile $ case args of - [] -> sources - _ -> args diff --git a/tools/dump-ast.hs b/tools/dump-ast.hs new file mode 100644 index 0000000..6d7105f --- /dev/null +++ b/tools/dump-ast.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Language.Cimple.IO (parseFile) +import System.Environment (getArgs) +import Text.Groom (groom) + + +processFile :: FilePath -> IO () +processFile source = do + putStrLn $ "Processing " ++ source + ast <- parseFile source + case ast of + Left err -> fail err + Right ok -> putStrLn $ groom ok + + +main :: IO () +main = do + args <- getArgs + case args of + [src] -> processFile src + _ -> fail "Usage: dump-ast " diff --git a/tools/dump-tokens.hs b/tools/dump-tokens.hs index 08b6512..cd90a92 100644 --- a/tools/dump-tokens.hs +++ b/tools/dump-tokens.hs @@ -1,14 +1,14 @@ module Main (main) where -import qualified Data.ByteString as BS -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import System.Environment (getArgs) -import Text.Groom (groom) -import Tokstyle.Cimple.Lexer (alexScanTokens) +import qualified Data.ByteString as BS +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Language.Cimple (alexScanTokens) +import System.Environment (getArgs) +import Text.Groom (groom) -parseFile :: FilePath -> IO () -parseFile source = do +processFile :: FilePath -> IO () +processFile source = do putStrLn $ "Processing " ++ source contents <- Text.unpack . Text.decodeUtf8 <$> BS.readFile source case alexScanTokens contents of @@ -19,5 +19,5 @@ main :: IO () main = do args <- getArgs case args of - [src] -> parseFile src + [src] -> processFile src _ -> fail "Usage: dump-tokens " diff --git a/web/Tokstyle/App.hs b/web/Tokstyle/App.hs deleted file mode 100644 index 6571583..0000000 --- a/web/Tokstyle/App.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -module Tokstyle.App (app) where - -import Control.Monad.IO.Class (liftIO) -import Data.ByteString (ByteString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Text.Encoding.Error as Text -import Servant - -import Tokstyle.Cimple.Analysis (analyse) -import Tokstyle.Cimple.AST (Node) -import qualified Tokstyle.Cimple.IO as Cimple -import Tokstyle.Cimple.Lexer (Lexeme) - - -type ParseResult = Either String [Node (Lexeme Text)] - --- API specification -type TokstyleApi = - -- Link to the source code repository, to comply with AGPL. - "source" :> Get '[PlainText] String - -- Parse a C file as Cimple AST. - :<|> "parse" :> ReqBody '[OctetStream] ByteString :> Post '[JSON] ParseResult - -- Run all Cimple analyses and return the diagnostics as list of strings. - :<|> "analyse" :> ReqBody '[JSON] (FilePath, ParseResult) :> Post '[JSON] [Text] - -tokstyleApi :: Proxy TokstyleApi -tokstyleApi = Proxy - --- Server-side handlers. --- --- There's one handler per endpoint, which, just like in the type --- that represents the API, are glued together using :<|>. --- --- Each handler runs in the 'Handler' monad. -server :: Server TokstyleApi -server = - sourceH - :<|> parseH - :<|> analyseH - where - sourceH = return "https://github.com/TokTok/hs-tokstyle" - - parseH = liftIO . Cimple.parseText . Text.decodeUtf8With Text.lenientDecode - - analyseH (_ , Left err) = return [Text.pack err] - analyseH (file, Right ast) = return $ analyse file ast - --- Turn the server into a WAI app. 'serve' is provided by servant, --- more precisely by the Servant.Server module. -app :: Application -app = serve tokstyleApi server diff --git a/web/webservice.hs b/web/webservice.hs deleted file mode 100644 index c71c915..0000000 --- a/web/webservice.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main (main) where - -import Network.Wai.Handler.Warp (Port, run) -import Network.Wai.Middleware.Cors (simpleCors) -import System.Environment (getArgs) -import System.IO (BufferMode (..), hSetBuffering, - stdout) - -import qualified Tokstyle.App as App - --- Run the server. -runTestServer :: Port -> IO () -runTestServer port = run port $ simpleCors App.app - --- Put this all to work! -main :: IO () -main = do - -- So real time logging works correctly. - hSetBuffering stdout LineBuffering - args <- getArgs - case args of - [port] -> runTestServer $ read port - _ -> runTestServer 8001