iGY2mzq2

1{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns #-}
2
3module Interpreter where
4
5import Control.Monad.Writer
6import Control.Monad.Reader
7import Control.Monad.State
8import Control.Exception
9import Data.List 
10
11import AST
12import Parse
13
14data Table 
15  = Table {getName :: DefinedName, getData :: [(ColumnType, DataTable)]}
16  deriving (Show, Read)
17
18type CommonTable = [Table]
19type DataTable = [Maybe (Data)]
20
21instance Eq ColumnType where
22  S a  == S b = a == b
23  I a  == I b = a == b
24  _    == _   = False
25
26instance Eq Data where
27  String str1 == String str2 = str1 == str2
28  Interpreter.Int int1 == Interpreter.Int int2 = int1 == int2
29  _ == _ = False
30
31data Data = String String | Int Int
32  deriving (Show,Read)
33data ColumnType = S DefinedName | I DefinedName
34   deriving (Show,Read)
35
36instance Eq Table where
37   a  == b = getName a == getName b
38   
39create :: DefinedName -> [ColumnType] -> Reader CommonTable (String, CommonTable)
40create tableName nameColumns = do
41  table <- ask
42  case or $ map (\t -> getName t == tableName) table of
43    True  -> return (">Error: Table with name this already exists", table)
44    False -> do
45      newTable <- local ((Table tableName (map (\name -> (name, [])) nameColumns)):) ask
46      return (">Done", newTable)
47
48executeInsert :: CommonTable -> DefinedName -> Maybe [DefinedName] -> [Data] -> Writer String CommonTable
49executeInsert commonTable tableName maybeNameColumns userData = do
50  let tryFind = find (\t -> getName t == tableName) commonTable
51  case tryFind of
52    Nothing    -> writer (commonTable, ">Error: table with name \'" ++ tableName ++ "\' does not exist")
53    Just table -> do
54     let
55        withoutTable = delete table commonTable
56        (lstTable,_) = unzip $ getData table
57        list = case maybeNameColumns of
58          Nothing          -> if (length lstTable == length userData) then zip lstTable userData else []
59          Just nameColumns -> do
60            True  <- return $ length (nub nameColumns) == length userData
61            True  <- return $ length nameColumns == length userData
62            (x,y) <- zip nameColumns userData
63            z     <- lstTable
64            case z of
65              S name -> do
66                True <- return $ x == name
67                return (S name, y)
68              I name -> do
69                True <- return $ x == name
70                return (I name, y)
71     if (length list == length userData) then do
72       let
73          f []         = ">Done"
74          f ((a,b):xs) = case a of
75            S name -> case b of
76              String _ -> f xs
77              Interpreter.Int str  -> ">Error: Column " ++ name ++ " should have type String, but " ++ show str ++ " is Int"
78            I name -> case b of
79              String str -> ">Error: Column " ++ name ++ " should have type Int, but '" ++ str ++ "' is String"
80              Interpreter.Int _      -> f xs
81
82          newTable = case f list of
83            ">Done" -> Table tableName (g $ getData table)
84            _       -> table
85
86          g []         = []
87          g ((a,b):xs) = case find (\(x,y) -> x == a) list of
88            Nothing    -> (a,b ++ [Nothing]):(g xs)
89            Just (x,y) -> (a,b ++ [Just y]):(g xs)
90       tell $ f list
91       return $ newTable:withoutTable
92     else do
93       tell ">Error: Type mismatch or column not recognized"
94       return commonTable