style fixes

This commit is contained in:
Felix Dilke 2026-01-27 17:33:44 +00:00
parent 94bc4f1faa
commit 4b358a8d6f

View File

@ -2,7 +2,6 @@
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Datalog.NaiveDatabase where
@ -70,7 +69,7 @@ withFacts facts =
where
extractFact :: Text -> Literal
extractFact factText =
case (parseDatalog factText) of
case parseDatalog factText of
Right (Fact fact) -> fact
Right otherStatement -> throw $ NonFactException factText otherStatement
Left ex -> throw $ CannotParseStatementException factText ex
@ -88,8 +87,7 @@ lookupRelation relationName relationMap newArity tuples =
case Map.lookup relationName relationMap of
Nothing -> Relation relationName newArity tuples []
Just relation ->
if (_arity relation == newArity)
then
if _arity relation == newArity then
let newTuples = Set.union tuples $ _tuples relation
in Relation relationName newArity newTuples []
else throw $ BadArityException relationName newArity
@ -117,8 +115,8 @@ maybeConstant (RuleElementConstant constant) = Just constant
maybeConstant _ = Nothing
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts rules =
foldr addRule (withFacts facts) (extractRule <$> rules)
withFactsAndRules facts =
foldr (addRule . extractRule) (withFacts facts)
where
extractRule :: Text -> (Literal, [Literal])
extractRule ruleText =
@ -139,7 +137,7 @@ withFactsAndRules facts rules =
relationMap' = Map.insert relationName relation relationMap
extraVariables = toElement <$> terms
variables' = nub extraVariables
extraConstants = catMaybes $ maybeConstant <$> variables'
extraConstants = mapMaybe maybeConstant variables'
constants' = Set.union (constants db) $ Set.fromList extraConstants
digestBody :: RuleContext -> Literal -> RuleContext
digestBody context (Literal neg subRelationName terms) =