Skip to content

Commit 4a700dd

Browse files
dnulnetsdnulnets
committed
Cleanup
1 parent e082f2e commit 4a700dd

File tree

4 files changed

+50
-44
lines changed

4 files changed

+50
-44
lines changed

‎backend/src/Accessability/Data/Analysis.hs‎

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
1-
{-# LANGUAGE DeriveAnyClass #-}
2-
{-# LANGUAGE DeriveGeneric #-}
1+
2+
33
{-# LANGUAGE FlexibleInstances #-}
4-
{-# LANGUAGE TemplateHaskell #-}
4+
55
{-# LANGUAGE TypeFamilies #-}
66
{-# LANGUAGE OverloadedStrings #-}
77

@@ -26,7 +26,7 @@ import Prelude
2626

2727
import qualified Data.Map as Map
2828
import Data.Maybe (Maybe (..), fromMaybe)
29-
import Data.Text (Text, pack, unpack)
29+
import Data.Text (Text, unpack)
3030

3131
import Control.Monad (join)
3232

@@ -36,27 +36,27 @@ import qualified Accessability.Data.User as U
3636

3737
-- |Determines the value of a POI based on the users properties
3838
evaluatePOI::[U.UserProperty] -> [Attribute] -> ItemValue
39-
evaluatePOI aup aav = foldr mappend mempty ((evaluateUserProperty $ toAttributeValueMap aav) <$> aup )
39+
evaluatePOI aup aav = mconcat (evaluateUserProperty (toAttributeValueMap aav) <$> aup )
4040

4141
where
4242

4343
toAttributeValueMap::[Attribute] -> Map.Map Text Attribute
44-
toAttributeValueMap a = Map.fromList $ (\av->((fromMaybe "" (attributeAttributeId av)), av)) <$> a
44+
toAttributeValueMap a = Map.fromList $ (\av->(fromMaybe "" (attributeAttributeId av), av)) <$> a
4545

4646
evaluateUserProperty::Map.Map Text Attribute -> U.UserProperty -> ItemValue
4747
evaluateUserProperty msa up = case join $ Map.lookup <$> Just (U.propertyAttributeId up) <*> Just msa of
4848
Nothing -> ItemValue {positive = 0, negative = 0, unknown = 1}
49-
Just a -> if (evaluate up a)
49+
Just a -> if evaluate up a
5050
then ItemValue {positive = 1, negative = 0, unknown = 0}
5151
else ItemValue {positive = 0, negative = 1, unknown = 0}
5252

5353
evaluate::U.UserProperty->Attribute->Bool
54-
evaluate up av = fromMaybe False (notit <$> Just (U.propertyNegate up)
55-
<*> (operate <$> Just (U.propertyOperation up)
56-
<*> (attributeValue av)
57-
<*> Just (U.propertyValue up)
58-
<*> Just (U.propertyValue1 up)
59-
<*> (Just (attributeTypeof av))))
54+
evaluate up av = Just True == (notit <$> Just (U.propertyNegate up)
55+
<*> (operate <$> Just (U.propertyOperation up)
56+
<*> attributeValue av
57+
<*> Just (U.propertyValue up)
58+
<*> Just (U.propertyValue1 up)
59+
<*> Just (attributeTypeof av)))
6060

6161
-- Logical xor
6262
notit::Bool->Bool->Bool
@@ -66,20 +66,20 @@ evaluatePOI aup aav = foldr mappend mempty ((evaluateUserProperty $ toAttributeV
6666
operate::U.Operation->Text->Text->Maybe Text->AttributeType->Bool
6767
operate U.EQ v1 v2 _ TextType = v1 == v2
6868
operate U.EQ v1 v2 _ BooleanType = v1 == v2
69-
operate U.EQ v1 v2 _ NumberType = ((read $ unpack v1)::Float) == (read $ unpack v2)
69+
operate U.EQ v1 v2 _ NumberType = ((read $ unpack v1)::Float) == read (unpack v2)
7070
operate U.LT v1 v2 _ TextType = v1 < v2
71-
operate U.LT v1 v2 _ BooleanType = False
72-
operate U.LT v1 v2 _ NumberType = ((read $ unpack v1)::Float) < (read $ unpack v2)
71+
operate U.LT _ _ _ BooleanType = False
72+
operate U.LT v1 v2 _ NumberType = ((read $ unpack v1)::Float) < read (unpack v2)
7373
operate U.LTE v1 v2 _ TextType = v1 <= v2
74-
operate U.LTE v1 v2 _ BooleanType = False
75-
operate U.LTE v1 v2 _ NumberType = ((read $ unpack v1)::Float) <= (read $ unpack v2)
74+
operate U.LTE _ _ _ BooleanType = False
75+
operate U.LTE v1 v2 _ NumberType = ((read $ unpack v1)::Float) <= read (unpack v2)
7676
operate U.GT v1 v2 _ TextType = v1 > v2
77-
operate U.GT v1 v2 _ BooleanType = False
78-
operate U.GT v1 v2 _ NumberType = ((read $ unpack v1)::Float) > (read $ unpack v2)
77+
operate U.GT _ _ _ BooleanType = False
78+
operate U.GT v1 v2 _ NumberType = ((read $ unpack v1)::Float) > read (unpack v2)
7979
operate U.GTE v1 v2 _ TextType = v1 >= v2
80-
operate U.GTE v1 v2 _ BooleanType = False
81-
operate U.GTE v1 v2 _ NumberType = ((read $ unpack v1)::Float) >= (read $ unpack v2)
80+
operate U.GTE _ _ _ BooleanType = False
81+
operate U.GTE v1 v2 _ NumberType = ((read $ unpack v1)::Float) >= read (unpack v2)
8282
operate U.IN v1 v21 (Just v22) TextType = v1 >= v21 && v1 <= v22
83-
operate U.IN v1 v21 (Just v22) BooleanType = False
84-
operate U.IN v1 v21 (Just v22) NumberType = ((read $ unpack v1)::Float) > (read $ unpack v21) && ((read $ unpack v1)::Float) < (read $ unpack v22)
83+
operate U.IN _ _ (Just _) BooleanType = False
84+
operate U.IN v1 v21 (Just v22) NumberType = ((read $ unpack v1)::Float) > read (unpack v21) && ((read $ unpack v1)::Float) < read (unpack v22)
8585
operate U.IN _ _ Nothing _ = False

‎backend/src/Accessability/Handler/REST/Authenticate.hs‎

Lines changed: 16 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -14,22 +14,33 @@ module Accessability.Handler.REST.Authenticate (postAuthenticateR, getAuthentica
1414
--
1515
-- External imports
1616
--
17-
import Data.Text (Text)
1817
import Data.Time.Clock.System (SystemTime (..),
1918
getSystemTime)
2019

21-
import Network.HTTP.Types.Status (status200, status401)
20+
import Network.HTTP.Types.Status (status401)
2221

23-
import Database.Persist.Sql
22+
import Database.Persist.Sql
23+
( Entity(Entity), PersistStoreRead(get), PersistUniqueRead(getBy) )
2424

25-
import Yesod
25+
import Yesod
26+
( Value(Null),
27+
ToJSON(toJSON),
28+
MonadIO(liftIO),
29+
getYesod,
30+
lookupBearerAuth,
31+
sendResponseStatus,
32+
requireCheckJsonBody,
33+
returnJson,
34+
YesodPersist(runDB) )
2635

2736
--
2837
-- Internal imports
2938
--
3039
import Accessability.Foundation (Handler, Server (..),
3140
getAuthenticatedUser)
32-
import Accessability.Model.Database
41+
import Accessability.Model.Database
42+
( Unique(UniqueUserUsername),
43+
User(userEmail, userUsername, userPassword) )
3344
import Accessability.Model.REST.Authenticate (Authenticate (..),
3445
UserInfo (..))
3546
import Accessability.Model.Transform (keyToText, textToKey)

‎backend/src/Accessability/Handler/REST/Item.hs‎

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,6 @@ where
2828
--
2929
-- Import standard libs
3030
--
31-
import Data.Aeson (encode)
3231
import Data.Maybe (fromMaybe)
3332
import Data.Text (Text, pack, splitOn)
3433
import qualified UnliftIO.Exception as UIOE
@@ -47,7 +46,6 @@ import Accessability.Data.Functor
4746
import Accessability.Data.Geo
4847
import Accessability.Data.Item (Attribute (..), Item (..),
4948
ItemValue (..))
50-
import qualified Accessability.Data.User as U
5149
import Accessability.Foundation (Handler, getAuthenticatedUser,
5250
requireAuthentication)
5351
import qualified Accessability.Handler.Database as DBF
@@ -172,7 +170,7 @@ postItemsR = do
172170
invalidArgs
173171
$ ["Unable to find any items in the database"]
174172
<> splitOn "\n" (pack e)
175-
Right items -> do
173+
Right items ->
176174
sendStatusJSON status200 items
177175

178176
-- | The REST get handler for items, i.e. a list of items based on a body where the
@@ -191,13 +189,13 @@ postItemsAndValuesR = do
191189
)
192190
(pure . Left . show)
193191
case result of
194-
Left e -> pure []
192+
Left _ -> pure []
195193
Right a -> pure a
196194
Nothing -> pure []
197195

198196
-- Get the items
199197
queryBody <- requireCheckJsonBody :: Handler PostItemsBody
200-
items <- (either (const []) id) <$> UIOE.catchAny
198+
items <- either (const []) id <$> UIOE.catchAny
201199
(fffmap
202200
toGenericItem
203201
(DBF.dbFetchItems
@@ -212,8 +210,8 @@ postItemsAndValuesR = do
212210
(pure . Left . show)
213211

214212
-- Calculate the value of the POI in respect to the user properties
215-
attrs <- sequence $ fetchItemAttributes <$> (toItemId items)
216-
sendStatusJSON status200 $ zipWith mergeItem items $ (evaluatePOI props) <$> attrs
213+
attrs <- sequence $ fetchItemAttributes <$> toItemId items
214+
sendStatusJSON status200 $ zipWith mergeItem items $ evaluatePOI props <$> attrs
217215

218216
where
219217

@@ -232,7 +230,7 @@ postItemsAndValuesR = do
232230
(fffmap toGenericItemAttribute $ DBF.dbFetchItemAttributes $ textToKey key)
233231
(pure . Left . show)
234232
case result of
235-
Left e -> pure []
233+
Left _ -> pure []
236234
Right a -> pure a
237235

238236

‎backend/src/Accessability/Handler/REST/User.hs‎

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@ module Accessability.Handler.REST.User (getUserPropertiesR, putUserPropertiesR)
1717
--
1818
-- Import standard libs
1919
--
20-
import Data.Aeson (encode)
2120
import Data.Maybe (fromMaybe)
2221
import Data.Text (Text, pack, splitOn)
2322
import qualified UnliftIO.Exception as UIOE
@@ -32,9 +31,7 @@ import Yesod
3231
-- My own imports
3332
--
3433
import Accessability.Data.Functor
35-
import Accessability.Data.Geo
36-
import Accessability.Foundation (Handler, getAuthenticatedUser,
37-
requireAuthentication)
34+
import Accessability.Foundation (Handler, getAuthenticatedUser)
3835
import qualified Accessability.Handler.Database as DBF
3936
import qualified Accessability.Model.Database as DB
4037
import Accessability.Model.REST.User
@@ -73,9 +70,9 @@ putUserPropertiesR = do
7370
case mkey of
7471
Just key -> do
7572
queryBody <- requireCheckJsonBody :: Handler [PutUserProperty]
76-
liftIO $ putStrLn $ show queryBody
73+
liftIO $ print queryBody
7774
result <- UIOE.catchAny
78-
(DBF.dbUpdateUserProperties ((doit key) <$> queryBody))
75+
(DBF.dbUpdateUserProperties (doit key <$> queryBody))
7976
(pure . Left . show)
8077
case result of
8178
Left e ->
@@ -97,7 +94,7 @@ putUserPropertiesR = do
9794
{ DB.userPropertyAttribute = textToKey $ fromMaybe
9895
"0000000000000000"
9996
(upattributeId pia)
100-
, DB.userPropertyNegate = fromMaybe False $ upnegate pia
97+
, DB.userPropertyNegate = Just True == upnegate pia
10198
, DB.userPropertyValue = fromMaybe "" $ upvalue pia
10299
, DB.userPropertyValue1 = upvalue1 pia
103100
, DB.userPropertyOperation = v

0 commit comments

Comments
 (0)