Parsing 使用Haskell的SQL连接

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

为了解析查询，程序分为两部分：解析部分和求值部分。我可以使用外部文件中的命令添加一个表并将数据放入表中，但是当我尝试使用Haskell map的union函数通过完整的外部连接来连接两个表时，我得到了以下错误

错误..

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

包含命令的文本文件。

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

代码..

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

---

第一个问题是您缺少

表达式

类型中的

连接

构造函数

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

编辑：第二个问题

---

您在两个位置调用

stringArray

变量

var1
而不是
Attributes
类型
Map.union
在四个方面而不是两个方面被调用。
Hi@Lucy，你能修改代码格式吗？在当前状态下，它无法编译，因为某些部分的格式不正确。@MCH我添加了Dropbox链接供您参考您的问题中的代码与您的Dropbox不匹配（请参阅MCH的答案）。下次尝试生成MCVE时，该过程通常会显示错误。请将文本（如错误消息）作为文本而不是图像发布。图像无法搜索或复制粘贴，而且往往更难阅读。@ThomasM.DuBuisson我在这里编写的代码是从Dropbox链接复制的。.请务必参考代码我添加了构造函数，但在上面的第二个屏幕截图中指定了一个巨大的错误。.知道是什么原因吗？你的
Join
构造函数看起来像什么？