dhscanner-kbgen 2.2.0 → 2.3.0

raw patch · 3 files changed

+307/−85 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dhscanner-kbgen.cabal +1/−1
• src/Kbgen.hs +176/−0
• test/SmokeTests.hs +130/−84

@@ -33,7 +33,7 @@         * explain in plain English your query's purpose         * et voilà ! -version:            2.2.0+version:            2.3.0 license:            GPL-3.0-only license-file:       LICENSE author:             OrenGitHub

@@ -64,6 +64,7 @@     ConstString(..),     ConstInteger(..),     MethodOfClass(..),+    MethodHasName(..),     ClassHas1stPartySuper(..),     ClassHas3rdPartySuper(..),     CallMethodOfUntypedNamedParam(..),@@ -72,6 +73,11 @@     ConstBoolTrue(..),     ConstNull(..),     GatedReturn(..),+    TopLevelIfThenElseGadget(..),+    CallGuardedByCondInThenPart(..),+    CallGuardedByCondInElsePart(..),+    ThenPart(..),+    ElsePart(..),     Comparison(..),     CallableReturnsValue(..),     CallableReturnsWithoutValue(..),@@ -727,6 +733,45 @@ -- This is how the fact will look inside the Prolog file -- -- @+-- kb_method_has_name( Method, Name ).+-- @+--+-- __When should I use this fact__+--+-- @+-- \@RestController+-- public class OidcRestController {+--     \@RequestMapping( method = RequestMethod.GET )+--     public void oidc( ... ) { ... }+-- }+-- @+--+-- __Writing a predicate with this fact and others__+--+-- @+-- method_of_class_by_names( Method, MethodName, ClassName ) :-+--     kb_method_has_name( Method, MethodName ),+--     kb_method_of_class( Method, Class ),+--     kb_class_def( Class, ClassName, _ ).+-- @+--+-- Other facts combined in this example predicate:+--+--     * 'MethodOfClass'+--     * 'ClassDef'+--+data MethodHasName = MethodHasName+    Method -- ^+    Token.MethodName -- ^+    deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )++-- |+--+-- __Name__+--+-- This is how the fact will look inside the Prolog file+--+-- @ -- kb_arg_i_for_call( Arg, Index, Call ). -- @ --@@ -1061,6 +1106,97 @@ -- This is how the fact will look inside the Prolog file -- -- @+-- kb_top_level_if_then_else_gadget( Callable, Cond, ThenPart, ElsePart ).+-- @+--+-- __When should I use this fact__+--+-- Every @if@ statement with a non-empty else, sitting directly in the+-- callable\'s body ( not nested inside another @if@ ), fires this fact.+-- The bitcode keeps no locations for the then \/ else parts, so both+-- wrap the location of the condition, and render as+-- @then_part_startloc_...@ \/ @else_part_startloc_...@.+--+-- @+-- if (isValidRedirectUrl(redirectUrl)) {+--     response.sendRedirect(redirectUrl);+-- } else {+--     response.sendError(HttpServletResponse.SC_BAD_REQUEST);+-- }+-- @+--+-- __Writing a predicate with this fact and others__+--+-- @+-- sanitized_by_error_in_else_part( Callable, Call, Cond ) :-+--     kb_top_level_if_then_else_gadget( Callable, Cond, ThenPart, ElsePart ),+--     kb_call_guarded_by_cond_in_then_part( Call, Cond, ThenPart ),+--     kb_call_guarded_by_cond_in_else_part( ErrorCall, Cond, ElsePart ),+--     kb_call_resolved( ErrorCall, \'jakarta.servlet.http.HttpServletResponse.sendError\' ).+-- @+--+-- Other facts combined in this example predicate:+--+--     * 'CallGuardedByCondInThenPart'+--     * 'CallGuardedByCondInElsePart'+--     * 'CallResolved'+--+data TopLevelIfThenElseGadget = TopLevelIfThenElseGadget+    Callable -- ^+    Cond -- ^+    ThenPart -- ^+    ElsePart -- ^+    deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )++-- |+--+-- __Name__+--+-- This is how the fact will look inside the Prolog file+--+-- @+-- kb_call_guarded_by_cond_in_then_part( Call, Cond, ThenPart ).+-- @+--+-- __When should I use this fact__+--+-- Every call in the then part of a 'TopLevelIfThenElseGadget' fires+-- this fact, including calls in @if@ statements nested inside it.+--+data CallGuardedByCondInThenPart = CallGuardedByCondInThenPart+    Call -- ^+    Cond -- ^+    ThenPart -- ^+    deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )++-- |+--+-- __Name__+--+-- This is how the fact will look inside the Prolog file+--+-- @+-- kb_call_guarded_by_cond_in_else_part( Call, Cond, ElsePart ).+-- @+--+-- __When should I use this fact__+--+-- Every call in the else part of a 'TopLevelIfThenElseGadget' fires+-- this fact, including calls in @if@ statements nested inside it.+--+data CallGuardedByCondInElsePart = CallGuardedByCondInElsePart+    Call -- ^+    Cond -- ^+    ElsePart -- ^+    deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )++-- |+--+-- __Name__+--+-- This is how the fact will look inside the Prolog file+--+-- @ -- kb_comparison( Cond, Lhs, Rhs, Op ). -- @ --@@ -1172,6 +1308,8 @@ data Rhs = Rhs Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data ComparisonOp = ComparisonOp String deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data ReturnedValue = ReturnedValue Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )+data ThenPart = ThenPart Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )+data ElsePart = ElsePart Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )  data Keyword = Keyword String deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data Resolved = Resolved Fqn.Fqn deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )@@ -1212,10 +1350,14 @@    | ConstBoolTrueCtor ConstBoolTrue    | ConstNullCtor ConstNull    | GatedReturnCtor GatedReturn+   | TopLevelIfThenElseGadgetCtor TopLevelIfThenElseGadget+   | CallGuardedByCondInThenPartCtor CallGuardedByCondInThenPart+   | CallGuardedByCondInElsePartCtor CallGuardedByCondInElsePart    | ComparisonCtor Comparison    | CallableReturnsValueCtor CallableReturnsValue    | CallableReturnsWithoutValueCtor CallableReturnsWithoutValue    | MethodOfClassCtor MethodOfClass+   | MethodHasNameCtor MethodHasName    | ClassAnnotationCtor ClassAnnotation    | ParamiOfCallableCtor ParamiOfCallable    | KeywordArgForCallCtor KeywordArgForCall@@ -1254,10 +1396,14 @@ prologify (ConstBoolTrueCtor content) = prologify_ConstBoolTrue content prologify (ConstNullCtor content) = prologify_ConstNull content prologify (GatedReturnCtor content) = prologify_GatedReturn content+prologify (TopLevelIfThenElseGadgetCtor content) = prologify_TopLevelIfThenElseGadget content+prologify (CallGuardedByCondInThenPartCtor content) = prologify_CallGuardedByCondInThenPart content+prologify (CallGuardedByCondInElsePartCtor content) = prologify_CallGuardedByCondInElsePart content prologify (ComparisonCtor content) = prologify_Comparison content prologify (CallableReturnsValueCtor content) = prologify_CallableReturnsValue content prologify (CallableReturnsWithoutValueCtor content) = prologify_CallableReturnsWithoutValue content prologify (MethodOfClassCtor content) = prologify_MethodOfClass content+prologify (MethodHasNameCtor content) = prologify_MethodHasName content prologify (ClassAnnotationCtor content) = prologify_ClassAnnotation content prologify (ParamiOfCallableCtor content) = prologify_ParamiOfCallable content prologify (ParamResolvedTypeCtor content) = prologify_ParamResolvedType content@@ -1359,6 +1505,30 @@ prologify_GatedReturn :: GatedReturn -> String prologify_GatedReturn (GatedReturn (Cond c) (ReturnedValue v)) = prologify_GatedReturn' c v +thenPartify :: Location -> String+thenPartify l = "then_part_" ++ locationify l++elsePartify :: Location -> String+elsePartify l = "else_part_" ++ locationify l++prologify_TopLevelIfThenElseGadget' :: Location -> Location -> Location -> Location -> String+prologify_TopLevelIfThenElseGadget' callable c t e = printf "kb_top_level_if_then_else_gadget( %s, %s, %s, %s )." (locationify callable) (locationify c) (thenPartify t) (elsePartify e)++prologify_TopLevelIfThenElseGadget :: TopLevelIfThenElseGadget -> String+prologify_TopLevelIfThenElseGadget (TopLevelIfThenElseGadget (Callable callable) (Cond c) (ThenPart t) (ElsePart e)) = prologify_TopLevelIfThenElseGadget' callable c t e++prologify_CallGuardedByCondInThenPart' :: Location -> Location -> Location -> String+prologify_CallGuardedByCondInThenPart' call c t = printf "kb_call_guarded_by_cond_in_then_part( %s, %s, %s )." (locationify call) (locationify c) (thenPartify t)++prologify_CallGuardedByCondInThenPart :: CallGuardedByCondInThenPart -> String+prologify_CallGuardedByCondInThenPart (CallGuardedByCondInThenPart (Call call) (Cond c) (ThenPart t)) = prologify_CallGuardedByCondInThenPart' call c t++prologify_CallGuardedByCondInElsePart' :: Location -> Location -> Location -> String+prologify_CallGuardedByCondInElsePart' call c e = printf "kb_call_guarded_by_cond_in_else_part( %s, %s, %s )." (locationify call) (locationify c) (elsePartify e)++prologify_CallGuardedByCondInElsePart :: CallGuardedByCondInElsePart -> String+prologify_CallGuardedByCondInElsePart (CallGuardedByCondInElsePart (Call call) (Cond c) (ElsePart e)) = prologify_CallGuardedByCondInElsePart' call c e+ prologify_Comparison' :: Location -> Location -> Location -> String -> String prologify_Comparison' c l r op = printf "kb_comparison( %s, %s, %s, %s )." (locationify c) (locationify l) (locationify r) op @@ -1382,6 +1552,12 @@  prologify_MethodOfClass :: MethodOfClass -> String prologify_MethodOfClass (MethodOfClass (Method m) (Class c)) = prologify_MethodOfClass' m c++prologify_MethodHasName' :: Location -> String -> String+prologify_MethodHasName' m name = printf "kb_method_has_name( %s, \'%s\' )." (locationify m) name++prologify_MethodHasName :: MethodHasName -> String+prologify_MethodHasName (MethodHasName (Method m) (Token.MethodName (Token.Named name _))) = prologify_MethodHasName' m name  prologify_ClassHas1stPartySuper' :: Location -> String -> FilePath -> String prologify_ClassHas1stPartySuper' c s f = printf "kb_class_has_1st_party_super( %s, \'%s\', \'%s\' )." (locationify c) s f

@@ -1,84 +1,130 @@-module SmokeTests (runSmokeTests) where
-
-import Kbgen
-    ( Cond (..)
-    , ConstNull (..)
-    , Fact (..)
-    , GatedReturn (..)
-    , ReturnedValue (..)
-    , locationify
-    , prologify
-    , restoreloc
-    )
-import Location (Location (..))
-import Test.Hspec (Spec, hspec, it, shouldBe)
-
-it' :: IO () -> String -> Spec
-it' testBody label = it label testBody
-
-completelyInvalidLocationString :: String
-completelyInvalidLocationString = "Blahhh"
-
-testCompletelyInvalidLocationString :: IO ()
-testCompletelyInvalidLocationString = restoreloc completelyInvalidLocationString `shouldBe` Nothing
-
-locationStringWithoutProperPrefix :: String
-locationStringWithoutProperPrefix = "____startloc_1_2_endloc_3_4_foo_dot_c"
-
-testLocationStringWithoutProperPrefix :: IO ()
-testLocationStringWithoutProperPrefix = restoreloc locationStringWithoutProperPrefix `shouldBe` Nothing
-
-locationStringWithoutProperFormatExample1 :: String
-locationStringWithoutProperFormatExample1 = "startloc_1_2_end_3_4_foo_dot_c"
-
-testLocationStringWithoutProperFormatExample1 :: IO ()
-testLocationStringWithoutProperFormatExample1 = restoreloc locationStringWithoutProperFormatExample1 `shouldBe` Nothing
-
-locationStringWithoutProperFormatExample2 :: String
-locationStringWithoutProperFormatExample2 = "startloc_1_2_endloc____3_4_foo_dot_c"
-
-testLocationStringWithoutProperFormatExample2 :: IO ()
-testLocationStringWithoutProperFormatExample2 = restoreloc locationStringWithoutProperFormatExample2 `shouldBe` Nothing
-
-locationStringWithoutProperFormatExample3 :: String
-locationStringWithoutProperFormatExample3 = "startloc_1_2_endloc_3______4_foo_dot_c"
-
-testLocationStringWithoutProperFormatExample3 :: IO ()
-testLocationStringWithoutProperFormatExample3 = restoreloc locationStringWithoutProperFormatExample3 `shouldBe` Nothing
-
-sampleLoc :: Word -> Location
-sampleLoc n =
-    Location
-        { lineStart = n
-        , colStart = n
-        , lineEnd = n
-        , colEnd = n
-        , filename = "foo.c"
-        }
-
-testPrologifyConstNull :: IO ()
-testPrologifyConstNull =
-    let loc = sampleLoc 1
-        expected = "kb_const_null( " ++ locationify loc ++ " )."
-    in prologify (ConstNullCtor (ConstNull loc)) `shouldBe` expected
-
-testPrologifyGatedReturn :: IO ()
-testPrologifyGatedReturn =
-    let condLoc = sampleLoc 1
-        retLoc = sampleLoc 2
-        gr = GatedReturn (Cond condLoc) (ReturnedValue retLoc)
-        expected = "kb_gated_return( " ++ locationify condLoc ++ ", " ++ locationify retLoc ++ " )."
-    in prologify (GatedReturnCtor gr) `shouldBe` expected
-
-tests :: Spec
-tests = do
-    it' testCompletelyInvalidLocationString "completelyInvalidLocationString should return Nothing"
-    it' testLocationStringWithoutProperPrefix "locationStringWithoutProperPrefix should return Nothing"
-    it' testLocationStringWithoutProperFormatExample1 "locationStringWithoutProperFormatExample1 should return Nothing"
-    it' testLocationStringWithoutProperFormatExample2 "locationStringWithoutProperFormatExample2 should return Nothing"
-    it' testLocationStringWithoutProperFormatExample3 "locationStringWithoutProperFormatExample3 should return Nothing"
-    it' testPrologifyConstNull "prologify_ConstNull should render kb_const_null( <loc> )."
-    it' testPrologifyGatedReturn "prologify_GatedReturn should render kb_gated_return( <cond>, <ret> )."
-
-runSmokeTests :: IO ()
-runSmokeTests = hspec tests
+module SmokeTests (runSmokeTests) where++import Kbgen+    ( Call (..)+    , CallGuardedByCondInElsePart (..)+    , CallGuardedByCondInThenPart (..)+    , Callable (..)+    , Cond (..)+    , ConstNull (..)+    , ElsePart (..)+    , Fact (..)+    , GatedReturn (..)+    , Method (..)+    , MethodHasName (..)+    , ReturnedValue (..)+    , ThenPart (..)+    , TopLevelIfThenElseGadget (..)+    , locationify+    , prologify+    , restoreloc+    )+import Location (Location (..))+import qualified Token+import Test.Hspec (Spec, hspec, it, shouldBe)++it' :: IO () -> String -> Spec+it' testBody label = it label testBody++completelyInvalidLocationString :: String+completelyInvalidLocationString = "Blahhh"++testCompletelyInvalidLocationString :: IO ()+testCompletelyInvalidLocationString = restoreloc completelyInvalidLocationString `shouldBe` Nothing++locationStringWithoutProperPrefix :: String+locationStringWithoutProperPrefix = "____startloc_1_2_endloc_3_4_foo_dot_c"++testLocationStringWithoutProperPrefix :: IO ()+testLocationStringWithoutProperPrefix = restoreloc locationStringWithoutProperPrefix `shouldBe` Nothing++locationStringWithoutProperFormatExample1 :: String+locationStringWithoutProperFormatExample1 = "startloc_1_2_end_3_4_foo_dot_c"++testLocationStringWithoutProperFormatExample1 :: IO ()+testLocationStringWithoutProperFormatExample1 = restoreloc locationStringWithoutProperFormatExample1 `shouldBe` Nothing++locationStringWithoutProperFormatExample2 :: String+locationStringWithoutProperFormatExample2 = "startloc_1_2_endloc____3_4_foo_dot_c"++testLocationStringWithoutProperFormatExample2 :: IO ()+testLocationStringWithoutProperFormatExample2 = restoreloc locationStringWithoutProperFormatExample2 `shouldBe` Nothing++locationStringWithoutProperFormatExample3 :: String+locationStringWithoutProperFormatExample3 = "startloc_1_2_endloc_3______4_foo_dot_c"++testLocationStringWithoutProperFormatExample3 :: IO ()+testLocationStringWithoutProperFormatExample3 = restoreloc locationStringWithoutProperFormatExample3 `shouldBe` Nothing++sampleLoc :: Word -> Location+sampleLoc n =+    Location+        { lineStart = n+        , colStart = n+        , lineEnd = n+        , colEnd = n+        , filename = "foo.c"+        }++testPrologifyConstNull :: IO ()+testPrologifyConstNull =+    let loc = sampleLoc 1+        expected = "kb_const_null( " ++ locationify loc ++ " )."+    in prologify (ConstNullCtor (ConstNull loc)) `shouldBe` expected++testPrologifyGatedReturn :: IO ()+testPrologifyGatedReturn =+    let condLoc = sampleLoc 1+        retLoc = sampleLoc 2+        gr = GatedReturn (Cond condLoc) (ReturnedValue retLoc)+        expected = "kb_gated_return( " ++ locationify condLoc ++ ", " ++ locationify retLoc ++ " )."+    in prologify (GatedReturnCtor gr) `shouldBe` expected++testPrologifyMethodHasName :: IO ()+testPrologifyMethodHasName =+    let methodLoc = sampleLoc 1+        name = Token.MethodName (Token.Named "oidc" (sampleLoc 2))+        mn = MethodHasName (Method methodLoc) name+        expected = "kb_method_has_name( " ++ locationify methodLoc ++ ", 'oidc' )."+    in prologify (MethodHasNameCtor mn) `shouldBe` expected++testPrologifyTopLevelIfThenElseGadget :: IO ()+testPrologifyTopLevelIfThenElseGadget =+    let callableLoc = sampleLoc 1+        condLoc = sampleLoc 2+        g = TopLevelIfThenElseGadget (Callable callableLoc) (Cond condLoc) (ThenPart condLoc) (ElsePart condLoc)+        expected = "kb_top_level_if_then_else_gadget( " ++ locationify callableLoc ++ ", " ++ locationify condLoc ++ ", then_part_" ++ locationify condLoc ++ ", else_part_" ++ locationify condLoc ++ " )."+    in prologify (TopLevelIfThenElseGadgetCtor g) `shouldBe` expected++testPrologifyCallGuardedByCondInThenPart :: IO ()+testPrologifyCallGuardedByCondInThenPart =+    let callLoc = sampleLoc 1+        condLoc = sampleLoc 2+        c = CallGuardedByCondInThenPart (Call callLoc) (Cond condLoc) (ThenPart condLoc)+        expected = "kb_call_guarded_by_cond_in_then_part( " ++ locationify callLoc ++ ", " ++ locationify condLoc ++ ", then_part_" ++ locationify condLoc ++ " )."+    in prologify (CallGuardedByCondInThenPartCtor c) `shouldBe` expected++testPrologifyCallGuardedByCondInElsePart :: IO ()+testPrologifyCallGuardedByCondInElsePart =+    let callLoc = sampleLoc 1+        condLoc = sampleLoc 2+        c = CallGuardedByCondInElsePart (Call callLoc) (Cond condLoc) (ElsePart condLoc)+        expected = "kb_call_guarded_by_cond_in_else_part( " ++ locationify callLoc ++ ", " ++ locationify condLoc ++ ", else_part_" ++ locationify condLoc ++ " )."+    in prologify (CallGuardedByCondInElsePartCtor c) `shouldBe` expected++tests :: Spec+tests = do+    it' testCompletelyInvalidLocationString "completelyInvalidLocationString should return Nothing"+    it' testLocationStringWithoutProperPrefix "locationStringWithoutProperPrefix should return Nothing"+    it' testLocationStringWithoutProperFormatExample1 "locationStringWithoutProperFormatExample1 should return Nothing"+    it' testLocationStringWithoutProperFormatExample2 "locationStringWithoutProperFormatExample2 should return Nothing"+    it' testLocationStringWithoutProperFormatExample3 "locationStringWithoutProperFormatExample3 should return Nothing"+    it' testPrologifyConstNull "prologify_ConstNull should render kb_const_null( <loc> )."+    it' testPrologifyGatedReturn "prologify_GatedReturn should render kb_gated_return( <cond>, <ret> )."+    it' testPrologifyMethodHasName "prologify_MethodHasName should render kb_method_has_name( <method>, '<name>' )."+    it' testPrologifyTopLevelIfThenElseGadget "prologify_TopLevelIfThenElseGadget should render kb_top_level_if_then_else_gadget( <callable>, <cond>, then_part_<cond>, else_part_<cond> )."+    it' testPrologifyCallGuardedByCondInThenPart "prologify_CallGuardedByCondInThenPart should render kb_call_guarded_by_cond_in_then_part( <call>, <cond>, then_part_<cond> )."+    it' testPrologifyCallGuardedByCondInElsePart "prologify_CallGuardedByCondInElsePart should render kb_call_guarded_by_cond_in_else_part( <call>, <cond>, else_part_<cond> )."++runSmokeTests :: IO ()+runSmokeTests = hspec tests