07fc59e · project-m36 · git.iko.soy

git.iko.soy/project-m36

switch from Int type to Integer type for IntAtom

resolves #138

commit07fc59e960df53b1fc9c392943368b3e6e3d6d2e authorAgentM <agentm@themactionfaction.com> dateSat 16 Sep 2017, 15:00 (9 years ago) parent6d78d19

12 files changed+51−42

compare with master

unifiedsplit

src/lib/ProjectM36/AtomFunctionError.hs+5−4 src/lib/ProjectM36/AtomFunctions/Primitive.hs+11−7 src/lib/ProjectM36/Atomable.hs+1−1 src/lib/ProjectM36/Base.hs+1−1 src/lib/ProjectM36/DataTypes/Day.hs+1−1 src/lib/ProjectM36/DataTypes/Interval.hs+4−4 src/lib/ProjectM36/DataTypes/List.hs+1−1 src/lib/ProjectM36/Relation.hs+4 src/lib/ProjectM36/Relation/Show/Gnuplot.hs+2−2 test/Relation/Atomable.hs+11−11 test/Relation/Tupleable.hs+8−8 test/TutorialD/Interpreter.hs+2−2

src/lib/ProjectM36/AtomFunctionError.hs+5−4

@@ -7,10 +7,11 @@ import Data.Text

88data AtomFunctionError = AtomFunctionUserError String |

99 AtomFunctionTypeMismatchError |

10− InvalidIntervalOrdering |

11− InvalidIntervalBoundaries |

12− AtomTypeDoesNotSupportOrdering Text |

13− AtomTypeDoesNotSupportInterval Text |

10+ InvalidIntervalOrderingError |

11+ InvalidIntervalBoundariesError |

12+ AtomFunctionEmptyRelationError |

13+ AtomTypeDoesNotSupportOrderingError Text |

14+ AtomTypeDoesNotSupportIntervalError Text |

1415 AtomFunctionBytesDecodingError String

1516 deriving(Generic, Eq, Show, Binary, NFData)

1617

src/lib/ProjectM36/AtomFunctions/Primitive.hs+11−7

@@ -1,6 +1,6 @@

11module ProjectM36.AtomFunctions.Primitive where

22import ProjectM36.Base

3−import ProjectM36.Relation (relFold)

3+import ProjectM36.Relation (relFold, oneTuple)

44import ProjectM36.Tuple

55import ProjectM36.AtomFunctionError

66import ProjectM36.AtomFunction

@@ -43,7 +43,7 @@ primitiveAtomFunctions = HS.fromList [

4343 atomFuncBody = body $ intAtomFuncLessThan True >=> boolAtomNot},

4444 AtomFunction { atomFuncName = "not",

4545 atomFuncType = [BoolAtomType, BoolAtomType],

46− atomFuncBody = body $ \(b:_) -> boolAtomNot b }

46+ atomFuncBody = body $ \(b:_) -> boolAtomNot b }

4747 ]

4848 where

4949 body = AtomFunctionBody Nothing

@@ -63,22 +63,26 @@ relationSum :: Relation -> Either AtomFunctionError Atom

6363relationSum relIn = pure (IntAtom (relFold (\tupIn acc -> acc + newVal tupIn) 0 relIn))

6464 where

6565 --extract Int from Atom

66− newVal :: RelationTuple -> Int

66+ newVal :: RelationTuple -> Integer

6767 newVal tupIn = castInt (tupleAtoms tupIn V.! 0)

6868

6969relationCount :: Relation -> Either AtomFunctionError Atom

70−relationCount relIn = pure (IntAtom (relFold (\_ acc -> acc + 1) (0::Int) relIn))

70+relationCount relIn = pure (IntAtom (relFold (\_ acc -> acc + 1) (0::Integer) relIn))

7171

7272relationMax :: Relation -> Either AtomFunctionError Atom

73−relationMax relIn = pure (IntAtom (relFold (\tupIn acc -> max acc (newVal tupIn)) minBound relIn))

73+relationMax relIn = case oneTuple relIn of

74+ Nothing -> Left AtomFunctionEmptyRelationError

75+ Just oneTup -> pure (IntAtom (relFold (\tupIn acc -> max acc (newVal tupIn)) (newVal oneTup) relIn))

7476 where

7577 newVal tupIn = castInt (tupleAtoms tupIn V.! 0)

7678

7779relationMin :: Relation -> Either AtomFunctionError Atom

78−relationMin relIn = pure (IntAtom (relFold (\tupIn acc -> min acc (newVal tupIn)) maxBound relIn))

80+relationMin relIn = case oneTuple relIn of

81+ Nothing -> Left AtomFunctionEmptyRelationError

82+ Just oneTup -> pure (IntAtom (relFold (\tupIn acc -> min acc (newVal tupIn)) (newVal oneTup) relIn))

7983 where

8084 newVal tupIn = castInt (tupleAtoms tupIn V.! 0)

8185

82−castInt :: Atom -> Int

86+castInt :: Atom -> Integer

8387castInt (IntAtom i) = i

8488castInt _ = error "attempted to cast non-IntAtom to Int"

src/lib/ProjectM36/Atomable.hs+1−1

@@ -56,7 +56,7 @@ class (Eq a, NFData a, Binary a, Show a) => Atomable a where

5656 default toAddTypeExpr :: (Generic a, AtomableG (Rep a)) => a -> DatabaseContextExpr

5757 toAddTypeExpr v = toAddTypeExprG (from v) (toAtomType v)

5858

59−instance Atomable Int where

59+instance Atomable Integer where

6060 toAtom = IntAtom

6161 fromAtom (IntAtom i) = i

6262 fromAtom e = error ("improper fromAtom" ++ show e)

src/lib/ProjectM36/Base.hs+1−1

@@ -27,7 +27,7 @@ import Data.ByteString (ByteString)

2727type StringType = Text

2828

2929-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.

30−data Atom = IntAtom Int |

30+data Atom = IntAtom Integer |

3131 DoubleAtom Double |

3232 TextAtom Text |

3333 DayAtom Day |

src/lib/ProjectM36/DataTypes/Day.hs+1−1

@@ -8,7 +8,7 @@ dayAtomFunctions :: AtomFunctions

88dayAtomFunctions = HS.fromList [

99 AtomFunction { atomFuncName = "fromGregorian",

1010 atomFuncType = [IntAtomType, IntAtomType, IntAtomType, DayAtomType],

11− atomFuncBody = compiledAtomFunctionBody $ \(IntAtom year:IntAtom month:IntAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) month day)

11+ atomFuncBody = compiledAtomFunctionBody $ \(IntAtom year:IntAtom month:IntAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))

1212 },

1313 AtomFunction { atomFuncName = "dayEarlierThan",

1414 atomFuncType = [DayAtomType, DayAtomType, BoolAtomType],

src/lib/ProjectM36/DataTypes/Interval.hs+4−4

@@ -39,7 +39,7 @@ supportsOrdering typ = case typ of

3939atomCompare :: Atom -> Atom -> Either AtomFunctionError Ordering

4040atomCompare a1 a2 = let aType = atomTypeForAtom a1

4141 go a b = Right (compare a b)

42− typError = Left (AtomTypeDoesNotSupportOrdering (prettyAtomType aType)) in

42+ typError = Left (AtomTypeDoesNotSupportOrderingError (prettyAtomType aType)) in

4343 if atomTypeForAtom a1 /= atomTypeForAtom a2 then

4444 Left AtomFunctionTypeMismatchError

4545 else if not (supportsOrdering aType) then

@@ -58,9 +58,9 @@ createInterval :: Atom -> Atom -> OpenInterval -> OpenInterval -> Either AtomFun

5858createInterval atom1 atom2 bopen eopen = do

5959 cmp <- atomCompare atom1 atom2

6060 case cmp of

61− GT -> Left InvalidIntervalOrdering

61+ GT -> Left InvalidIntervalOrderingError

6262 EQ -> if bopen || eopen then

63− Left InvalidIntervalBoundaries

63+ Left InvalidIntervalBoundariesError

6464 else

6565 Right valid

6666 LT -> Right valid

@@ -79,7 +79,7 @@ intervalAtomFunctions = HS.fromList [

7979 if supportsInterval aType then

8080 createInterval atom1 atom2 bopen eopen

8181 else

82− Left (AtomTypeDoesNotSupportInterval (prettyAtomType aType))

82+ Left (AtomTypeDoesNotSupportIntervalError (prettyAtomType aType))

8383 },

8484 AtomFunction {

8585 atomFuncName = "interval_overlaps",

src/lib/ProjectM36/DataTypes/List.hs+1−1

@@ -39,7 +39,7 @@ listAtomFunctions = HS.fromList [

3939 atomFuncType = [listAtomType (TypeVariableType "a"), IntAtomType],

4040 atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> do

4141 c <- listLength listAtom

42− pure (IntAtom c))

42+ pure (IntAtom (fromIntegral c)))

4343 },

4444 AtomFunction {

4545 atomFuncName = "maybeHead",

src/lib/ProjectM36/Relation.hs+4

@@ -319,3 +319,7 @@ randomizeTupleOrder (Relation attrs tupSet) = do

319319 newTupSet <- shuffleM (asList tupSet)

320320 pure (Relation attrs (RelationTupleSet newTupSet))

321321

322+-- returns a tuple from the tupleset- this is useful for priming folds over the tuples

323+oneTuple :: Relation -> Maybe RelationTuple

324+oneTuple (Relation _ (RelationTupleSet [])) = Nothing

325+oneTuple (Relation _ (RelationTupleSet (x:_))) = Just x

src/lib/ProjectM36/Relation/Show/Gnuplot.hs+2−2

@@ -23,8 +23,8 @@ data PlotError = InvalidAttributeCountError |

2323

2424--plotRelation :: Relation -> Either PlotError

2525

26−intFromAtomIndex :: Int -> RelationTuple -> Int

27−intFromAtomIndex index tup = castInt $ tupleAtoms tup V.! index

26+intFromAtomIndex :: Int -> RelationTuple -> Int --warning- clips or overflows Integer -> Int

27+intFromAtomIndex index tup = fromIntegral $ castInt $ tupleAtoms tup V.! index

2828

2929graph1DRelation :: Relation -> Plot2D.T Int Int

3030graph1DRelation rel = Plot2D.list Graph2D.listPoints $ points1DRelation rel

test/Relation/Atomable.hs+11−11

@@ -14,31 +14,31 @@ import Data.Text

1414import qualified Data.Map as M

1515

1616{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}

17−data Test1T = Test1C Int

17+data Test1T = Test1C Integer

1818 deriving (Generic, Show, Eq, Binary, NFData, Atomable)

1919

2020data Test2T x = Test2C x

2121 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

2222

23−data Test3T = Test3C Int Int

23+data Test3T = Test3C Integer Integer

2424 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

2525

26−data Test4T = Test4Ca Int |

27− Test4Cb Int

26+data Test4T = Test4Ca Integer |

27+ Test4Cb Integer

2828 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

2929

30−data TestListT = TestListC [Int]

30+data TestListT = TestListC [Integer]

3131 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

3232

3333data Test5T = Test5C {

34− con1 :: Int,

35− con2 :: Int

34+ con1 :: Integer,

35+ con2 :: Integer

3636 } deriving (Show, Generic, Eq, Binary, NFData, Atomable)

3737

38−data Test6T = Test6C (Maybe Int)

38+data Test6T = Test6C (Maybe Integer)

3939 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

4040

41−data Test7T = Test7C (Either Int Int)

41+data Test7T = Test7C (Either Integer Integer)

4242 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

4343

4444main :: IO ()

@@ -52,8 +52,8 @@ testList = TestList [testHaskell2DB, testADT1, testADT2, testADT3, testADT4, tes

5252-- test some basic data types like int, day, etc.

5353testBasicMarshaling :: Test

5454testBasicMarshaling = TestCase $ do

55− assertEqual "to IntAtom" (IntAtom 5) (toAtom (5 :: Int))

56− assertEqual "from IntAtom" (5 :: Int) (fromAtom (IntAtom 5))

55+ assertEqual "to IntAtom" (IntAtom 5) (toAtom (5 :: Integer))

56+ assertEqual "from IntAtom" (5 :: Integer) (fromAtom (IntAtom 5))

5757

5858 assertEqual "to BoolAtom" (BoolAtom False) (toAtom False)

5959 assertEqual "from BoolAtom" False (fromAtom (BoolAtom False))

test/Relation/Tupleable.hs+8−8

@@ -15,30 +15,30 @@ import System.Exit

1515{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}

1616

1717data Test1T = Test1C {

18− attrA :: Int

18+ attrA :: Integer

1919 }

2020 deriving (Generic, Eq, Show)

2121

2222data Test2T = Test2C {

23− attrB :: Int,

24− attrC :: Int

23+ attrB :: Integer,

24+ attrC :: Integer

2525 }

2626 deriving (Generic, Eq, Show)

2727

28−data Test3T = Test3C Int

28+data Test3T = Test3C Integer

2929 deriving (Generic, Eq, Show)

3030

3131data Test4T = Test4C

3232 deriving (Generic, Eq, Show)

3333

34−data Test5T = Test5C1 Int |

35− Test5C2 Int

34+data Test5T = Test5C1 Integer |

35+ Test5C2 Integer

3636 deriving (Generic, Eq, Show)

3737

38−data Test6T = Test6C T.Text Int Double

38+data Test6T = Test6C T.Text Integer Double

3939 deriving (Generic, Eq, Show)

4040

41−data Test7A = Test7AC Int

41+data Test7A = Test7AC Integer

4242 deriving (Generic, Show, Eq, Binary, NFData, Atomable)

4343

4444

test/TutorialD/Interpreter.hs+2−2

@@ -441,8 +441,8 @@ testIntervalAtom = TestCase $ do

441441 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

442442 executeTutorialD sessionId dbconn "x:=relation{tuple{n 1, a interval(3,4,f,f), b interval(4,5,f,f)}, tuple{n 2,a interval(3,4,t,t), b interval(4,5,t,t)}}"

443443 --test failed interval creation

444− let err1 = "AtomFunctionUserError InvalidIntervalOrdering"

445− err2 = "AtomFunctionUserError (AtomTypeDoesNotSupportInterval \"Text\")"

444+ let err1 = "AtomFunctionUserError InvalidIntervalOrderingError"

445+ err2 = "AtomFunctionUserError (AtomTypeDoesNotSupportIntervalError \"Text\")"

446446 expectTutorialDErr sessionId dbconn (T.isPrefixOf err1) "z:=relation{tuple{a interval(4,3,f,f)}}"

447447 expectTutorialDErr sessionId dbconn (T.isPrefixOf err2) "z:=relation{tuple{a interval(\"s\",\"t\",f,f)}}"

448448