如何避免過多的樣板匹配構造函數

Question

我目前正在實施Lexer/Parser。還有一兩件事，我的錯誤是，目前在我Parser.hs一半的我的代碼將被專用於僅僅讓單個標記：

對於小數據類型是這樣的：

data Tok 
    = IdLower String 
    | IdUpper String 
    | IdSymbol String 
    | IdColon String 
    | Equals 
    | Newline 

我似乎需要這樣的事：

idLower :: Parser String 
idLower = get >>= \s -> if 
    | (_, IdLower n) :- xs <- s -> put xs *> pure n 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

idUpper :: Parser String 
idUpper = get >>= \s -> if 
    | (_, IdUpper n) :- xs <- s -> put xs *> pure n 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

idSymbol :: Parser String 
idSymbol = get >>= \s -> if 
    | (_, IdSymbol n) :- xs <- s -> put xs *> pure n 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

idColon :: Parser String 
idColon = get >>= \s -> if 
    | (_, IdColon n) :- xs <- s -> put xs *> pure n 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

equals :: Parser() 
equals = get >>= \s -> if 
    | (_, Equals) :- xs <- s -> put xs 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

newline :: Parser() 
newline = get >>= \s -> if 
    | (_, Newline) :- xs <- s -> put xs 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

這就好比是99％重複的代碼，它們之間唯一的區別是使用的構造，以及我是否有類似pure n對於有內容的人。

我嘗試過重構一下，以便每個符號只有一個Tok -> Maybe()或Tok -> Maybe String函數，然後創建一個高階函數，將這些函數作爲參數。但是每個Tok -> Maybe a函數需要3行加上1行的間隔符，現在我需要另一個更高階的函數來支持它，如果我想要shorthands，所以我可以使用idLower而不是getToken idLower，那麼我最終的代碼總數，如果不是更多！

我只是真的希望有一個替代上述。現在我知道我可以通過創建一個自動失敗的函數來減少一些重複，這個函數總是會調用相關的throwError，如果第一個守衛沒有命中，我可以推遲這個函數，但即使如此，這仍然相當嚴重。

Answer 1

您可以通過使用棱鏡（例如lens library）「免費」（通過模板哈斯克爾）獲得Tok -> Maybe()和Tok -> Maybe String函數。

data Tok = 
    IdLower String 
    | IdUpper String 
    | IdSymbol String 
    | IdColon String 
    | Equals 
    | Newline 

makePrisms ''Tok 

現在，你可以說：

GHCi> preview _IdLower (IdLower "foo") 
Just "foo" 
GHCi> preview _IdLower (IdUpper "Foo") 
Nothing 

然後，你建議你自己，你可以從你的具體令牌功能的棱鏡摘要：

tok :: Prism' Tok a -> Parser a 
tok p = get >>= \ s -> if 
    | (_, t) :- xs <- s, Just n <- preview p t -> put xs *> pure n 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")] 

然後您就可以通過說tok _IdLower或tok _Equals獲得個別功能。

Answer 2

這是一種不同的方法，也需要一些樣板代碼，但沒有模板哈斯克爾。

它是基於重組的Tok類型，這樣就可以使用相等測試的形式，而不是匹配，並能均勻提取令牌的有效載荷：

data Tok where 
    Tok :: TokKind a -> a -> Tok 

每個令牌有一個令牌種類和有效載荷。該類型的令牌種是GADT 確定有效載荷的類型：

data TokKind :: * -> * where 
    IdLower :: TokKind String 
    IdUpper :: TokKind String 
    IdSymbol :: TokKind String 
    IdColon :: TokKind String 
    Equal :: TokKind() 
    Newline :: TokKind() 

現在我們需要平等的一種形式，它意味着，如果兩個標記具有相同類型的，其有效載荷類型必須兼容。這是testEquality從Data.Type.Equality不（不幸的是，目前無法在任何簡單的方法再次使用TH派生除外）：

instance TestEquality TokKind where 
    testEquality IdLower IdLower = Just Refl 
    testEquality IdUpper IdUpper = Just Refl 
    testEquality IdSymbol IdSymbol = Just Refl 
    testEquality IdColon IdColon = Just Refl 
    testEquality Equal Equal = Just Refl 
    testEquality Newline Newline = Just Refl 
    testEquality _  _  = Nothing 

那麼你的參數令牌功能變得

tok :: TokKind a -> Parser a 
tok tk' = get >>= \ s -> if 
    | (_, Tok tk x) :- xs <- s, Just Refl <- testEquality tk tk' -> put xs *> pure x 
    | (l, t) :- _ <- s -> throwError [(l, "Unexpected " <> description t)] 
    | Nil l <- s -> throwError [(l, "Unexpected end of input")]