Я новичок в Haskell, поэтому некоторые могут посчитать этот вопрос глупым. Я пытаюсь создать интерпретатор, похожий на SQL, используя библиотеку parsec haskell. Я храню данные на карте Haskell.
Для разбора запроса программа разбита на 2 части и анализирующие части. Я могу добавить таблицу и поместить данные в таблицу, используя команды из внешнего файла, но когда я пытаюсь объединить 2 таблицы с помощью полного внешнего объединения, используя функцию объединения карты Haskell, я получаю следующую ошибку.
Error ..
Текстовый файл с командами.
add User (name, age, company);
put (Alice, 28, Apple) to User;
put (Bob, 30, Google) to User;
put (Trudy, 29, Uber) to User;
add Movie (name, year);
put (Titanic, 1998) to Movie;
put (Inception, 2008) to Movie;
put (Xmen, 2017, 12) to Movie;
join User to Movie;
Код ..
module SqlLikeInterp (
Expression(..),
runFile,
showParsedExp,
run
) where
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Text.ParserCombinators.Parsec
import Control.Monad.Except
type Variable = String
type ErrorMsg = String
type Attributes = [Variable]
type Payload = [Attributes]
type Store = Map Variable Payload
data Expression =
Add Variable Attributes
| Put Attributes Variable
| Join Variable Variable
| Sequence Expression Expression
| Noop
deriving (Show)
fileP :: GenParser Char st Expression
fileP = do
prog <- exprP
eof
return prog
exprP = do
e <- exprP'
rest <- optionMaybe restSeqP
return (case rest of
Nothing -> e
Just e' -> Sequence e e')
restSeqP = do
char ';'
exprP
exprP' = do
spaces
t <- termP
spaces
return t
-- All terms can be distinguished by looking at the first character
termP = addP
<|> putP
<|> joinP
<|> emptyP
<?> "add, put, or join"
emptyP = do
_ <- spaces
return $ Noop
addP = do
_ <- string "add"
_ <- spaces
e1 <- varP
_ <- spaces
e2 <- attributesP
return $ Add e1 e2
varP = do
vStr <- many1 letter
return vStr
attributesP = do
_ <- char '('
v <- varPs
_ <- char ')'
return v
varPs = sepBy cell (char ',')
cell = do
_ <- spaces
p <- many (noneOf ",\n) ")
_ <- spaces
return p
putP = do
_ <- string "put"
_ <- spaces
e <- attributesP
_ <- spaces
_ <- string "to"
_ <- spaces
e1 <- varP
return $ Put e e1
joinP = do
_ <- string "join"
_ <- spaces
e <- varP
_ <- spaces
_ <- string "with"
_ <- spaces
e1 <- varP
return $ Join e e1
showParsedExp fileName = do
p <- parseFromFile fileP fileName
case p of
Left parseErr -> print parseErr
Right exp -> print exp
evaluate (Add var attrs) s = do
case (Map.lookup var s) of
Nothing -> return ("Added table: " ++ var ++ ", attributes: " ++ stringArray(attrs) ++ "\n", Map.insert var [attrs] s)
Just v -> return("Table already exists: " ++ var ++ ", attributes: " ++ stringArray(head(v)) ++ "\n", s)
evaluate (Put attrs var) s = do
case (Map.lookup var s) of
Nothing -> return ("Table doesn't exist: " ++ var ++ "\n", s)
Just v -> if (length(attrs) == length(head(v)))
then return (
"Added record: " ++ stringArray(attrs) ++ ", to table: " ++ var ++ ", attributes: " ++ stringArray(head(v)) ++ "\n",
Map.insert var (v ++ [attrs]) s
)
else return (
"Need " ++ show (length (head(v))) ++ " attributes: " ++ stringArray (head(v)) ++ " for table: " ++ var ++ ", but given " ++ show (length (attrs)) ++ " attributes: " ++ stringArray (attrs) ++ "\n",
s
)
evaluate (Join var var1) s = do
case (Map.lookup var s) of
Nothing -> return ("Table doesn't exist: " ++ var ++ "\n", s)
Just v -> if (length(var) == length(head(v)))
then return (
"Joined table: " ++ stringArray(var) ++ ", to table: " ++ var1 ++ ", attributes: " ++ stringArray(head(v)) ++ "\n",
Map.union var var1 (v) s
)
else return (
"Need " ++ show (length (head(v))) ++ " attributes: " ++ stringArray (head(v)) ++ " for table: " ++ var1 ++ ", but given " ++ show (length (var)) ++ " attributes: " ++ stringArray (var) ++ "\n",
s
)
evaluate (Sequence e1 e2) s = do
(v1, s1) <- evaluate e1 s
(v2, s') <- evaluate e2 s1
return (v1 ++ v2, s')
evaluate (Noop) s = do
return ("", s)
stringArray :: Attributes -> String
stringArray a = "[" ++ (intercalate ", " (a)) ++ "]"
run :: Expression -> Either ErrorMsg (Variable, Store)
run prog = evaluate prog Map.empty
runFile fileName = do
p <- parseFromFile fileP fileName
case p of
Left parseErr -> print parseErr
Right exp ->
case (run exp) of
Left msg -> print msg
Right (v,s) -> putStr v
Не могу понять, где я иду не так .. Пожалуйста, помогите
РЕДАКТИРОВАТЬ 1 ..
Это ссылка Dropbox для тех, кто сталкивается с ошибками компиляции
https://www.dropbox.com/s/f9w7s8efeez63xu/sql.hs?dl=0
После добавления конструктора Join в выражении я получаю следующую ошибку
[1 of 1] Compiling SqlLikeInterp ( sql.hs, interpreted )
sql.hs:142:43: error:
* Couldn't match type `Char' with `[Char]'
Expected type: Attributes
Actual type: Variable
* In the first argument of `stringArray', namely `(var1)'
In the first argument of `(++)', namely `stringArray (var1)'
In the second argument of `(++)', namely
`stringArray (var1)
++
", to table: "
++ var ++ ", attributes: " ++ stringArray (head (v)) ++ "\n"'
|
142 | "Updated record: " ++ stringArray(var1) ++ ", to table: "
++ var +
+ ", attributes: " ++ stringArray(head(v)) ++ "\n",
| ^^^^
sql.hs:143:9: error:
* Couldn't match expected type `[Attributes]
-> Map Variable [Attributes] -> Map Variable
[Attributes]'
with actual type `Map k0 a0'
* The function `Map.union' is applied to four arguments,
but its type `Map k0 a0 -> Map k0 a0 -> Map k0 a0' has only two
In the expression: Map.union var1 var (v) s
In the first argument of `return', namely
`("Updated record: "
++
stringArray (var1)
++
", to table: "
++ var ++ ", attributes: " ++ stringArray (head (v)) ++ "\n"
,
Map.union var1 var (v) s)'
|
143 | Map.union var1 var (v) s
| ^^^^^^^^^^^^^^^^^^^^^^^^
sql.hs:143:19: error:
* Couldn't match type `[Char]' with `Map k0 a0'
Expected type: Map k0 a0
Actual type: Variable
* In the first argument of `Map.union', namely `var1'
In the expression: Map.union var1 var (v) s
In the first argument of `return', namely
`("Updated record: "
++
stringArray (var1)
++
", to table: "
++ var ++ ", attributes: " ++ stringArray (head (v)) ++ "\n"
,
Map.union var1 var (v) s)'
|
143 | Map.union var1 var (v) s
| ^^^^
sql.hs:143:24: error:
* Couldn't match type `[Char]' with `Map k0 a0'
Expected type: Map k0 a0
Actual type: Variable
* In the second argument of `Map.union', namely `var'
In the expression: Map.union var1 var (v) s
In the first argument of `return', namely
`("Updated record: "
++
stringArray (var1)
++
", to table: "
++ var ++ ", attributes: " ++ stringArray (head (v)) ++ "\n"
,
Map.union var1 var (v) s)'
|
143 | Map.union var1 var (v) s
| ^^^
sql.hs:146:190: error:
* Couldn't match type `Char' with `[Char]'
Expected type: Attributes
Actual type: Variable
* In the first argument of `stringArray', namely `(var1)'
In the first argument of `(++)', namely `stringArray (var1)'
In the second argument of `(++)', namely
`stringArray (var1) ++ "\n"'
|
146 | "Need " ++ show (length (head(v))) ++ " attributes: " ++
stringArr
ay (head(v)) ++ " for table: " ++ var ++ ", but given " ++ show (length
(var1))
++ " attributes: " ++ stringArray (var1) ++ "\n",
|
^^^^
Failed, no modules loaded.