使用 Haskell 进行 SQL 连接

Question

我是 haskell 的新手，所以有些人可能会觉得这个问题很愚蠢。我正在尝试使用 haskell 的 parsec 库制作类似 SQL 的解释器。我将数据存储在 Haskell 映射中。

为了解析查询，程序分为解析和评估两部分。我可以使用来自外部文件的命令添加一个表并将数据放入表中，但是当我尝试使用 Haskell 映射的联合函数通过完全外部连接来连接 2 个表时，我收到以下错误。

错误..

带有命令的文本文件。

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.

Answer 1

第一个问题是您缺少 Expression 类型中的 Join 构造函数。

data Expression =
    Add Variable Attributes
  | Put Attributes Variable
  | Get Attributes Variable
  | Delete Attributes Variable
  | Update Attributes Variable
  | Sequence Expression Expression
  | Noop
  deriving (Show)

编辑：第二个问题

您在两个地方调用stringArray Variable var1 而不是Attributes 类型。 Map.union 在四件事上被调用而不是两件事。