[Fencommits] fenserve: start working on rewrite of potions / db infrastructure

[Benja Fallenstein]

Mon Jun  4 23:11:48 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * start working on rewrite of potions / db infrastructure
diff -rN -u old-fenserve/fendata/Types.hs new-fenserve/fendata/Types.hs
--- old-fenserve/fendata/Types.hs	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/fendata/Types.hs	2007-06-04 23:12:20.000000000 +0300
@@ -0,0 +1,113 @@
+{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
+
+module Types where
+
+import HTML
+import Utils
+
+import Control.Monad.Reader (Reader)
+
+import Data.Generics (Typeable, Data)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+
+----------------------------------------------------------------------------
+-- Data
+----------------------------------------------------------------------------
+
+type CategoryId = Int
+type FieldId = Int
+type ItemId = Int
+
+data BaseType = InlineType | BlockType | BooleanType | NumberType
+              | EmailType | WebLinkType | DateType | ItemType CategoryId
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+              
+data Type = Single BaseType | Multiple BaseType
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+data Value = InlineValue String
+           | BlockValue String
+           | BooleanValue Bool
+           | NumberValue Float
+           | EmailValue String
+           | WebLinkValue String
+           | DateValue { dYear :: Int, dMonth :: Int, dDay :: Int }
+           | ItemValue CategoryId ItemId
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+           
+data Category = Category { catId :: CategoryId, catName :: String,
+                           catFields :: [Field] }
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+           
+data Field = Field { fieldId :: FieldId, fieldName :: String,
+                     fieldCat :: CategoryId, fieldType :: Type }
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+                     
+data Item = Item { itemId :: ItemId, itemCategories :: Set CategoryId,
+                   itemValues :: Map FieldId Value }
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+data DB = DB { dbCategories :: Map CategoryId Category,
+               dbItems :: Map ItemId Item, dbNextId :: Int }
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+               
+u_catName   f (Category a b c) = Category a (f b) c
+u_catFields f (Category a b c) = Category a b (f c)
+
+u_fieldName f (Field a b c d) = Field a (f b) c d
+u_fieldCat  f (Field a b c d) = Field a b (f c) d
+u_fieldType f (Field a b c d) = Field a b c (f d)
+
+u_itemCategories f (Item a b c) = Item a (f b) c
+u_itemValues     f (Item a b c) = Item a b (f c)
+
+u_dbCategories f (DB a b c) = DB (f a) b c
+u_dbItems      f (DB a b c) = DB a (f b) c
+
+u_item x f = u_dbItems $ Map.adjust f x
+u_cat  x f = u_dbCategories $ Map.adjust f x
+
+
+
+----------------------------------------------------------------------------
+-- Utilities
+----------------------------------------------------------------------------
+
+data Typeable a => Template a = TCons HTML a (Template a) | TNil HTML
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+
+
+----------------------------------------------------------------------------
+-- Potions
+----------------------------------------------------------------------------
+
+type FunId = String
+
+data Order = Ascending | Descending
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+data Fun = Fun (Template Type) Type Exp
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+    
+data Exp' e = Var Int
+            | Call FunId [e]
+            | Literal Value
+            | GetField CategoryId FieldId (e)
+            | AllItems CategoryId
+            | Sort e e Order
+            | Filter e e
+            | Add e e | Subtract e e | Mul e e | Div e e | Sum e | Product e
+            | Count e
+            | LT e e | LE e e | EQ e e | GE e e | GT e e
+            | IfThenElse e e e
+            | Today | AddMonths e e | AddDays e e
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+    
+data Exp = Exp (Exp' Exp) | Hole
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+