style fixes
This commit is contained in:
parent
94bc4f1faa
commit
4b358a8d6f
@ -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) =
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user