我正在尝试关注ghci debugger documentation到我的堆栈项目，并通过运行$ stack ghci进入了repl。当我尝试在模块Api.Checklist的第207行设置断点时，出现以下错误。
> :break Api.Checklist 207
No breakpoints found at that location.
未设置断点，如:show breaks的空结果所示。
> :show breaks
No active breakpoints.
为什么> :break Api.Checklist 207无法设置断点？
编辑：
根据要求，Api.Checklist的内容如下，其中第207行是行checklistAnswerPG entryId apiAnswer =。
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
module Api.Checklist where
import Control.Monad (mapM, mapM_)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, Value(..),
toJSON, encode)
import qualified Data.HashMap.Strict as M
import Data.Text (Text, pack)
import Data.Time.Clock (UTCTime, getCurrentTime)
import GHC.Generics (Generic)
import qualified Opaleye as O
import Servant
import Api.Shared
import App
import Models.Checklist
import Models.ChecklistAnswer
import Models.ChecklistEntry
import Models.ChecklistQuestion
import Models.ChecklistTemplate
import Models.Validation (Errors(..), Validatable,
Validation,
ValidationResult (Failure, Success),
errors, failure, keyToField,
validate, validateEntity)
import Queries.Checklist
import Types.JWTUser
data ApiAnswer = ApiAnswer { questionId :: Int, answer :: Maybe Bool }
deriving (Generic)
data ApiChecklistEntryWrite = ApiChecklistEntryWrite { answers :: [ApiAnswer] }
deriving (Generic)
instance FromJSON ApiAnswer
instance FromJSON ApiChecklistEntryWrite
instance Validatable ApiChecklistEntryWrite where
validateEntity entry = do
mapM_ validateAnswer $ answers entry
where
validateAnswer :: ApiAnswer -> Validation
validateAnswer apiAnswer = do
case answer (apiAnswer :: ApiAnswer) of
Just _ ->
return ()
Nothing ->
failure (pack $ "answers[questionId=" ++ show (questionId (apiAnswer :: ApiAnswer)) ++ "]") ["must not be null"]
type ChecklistAPI = Get '[JSON] ChecklistRead
:<|> ReqBody '[JSON] TemplateChecklist :> Patch '[JSON] ChecklistRead
:<|> "entries" :> Get '[JSON] [ChecklistEntryRead]
:<|> "entries" :> Capture "checklistEntryId" Int :> Get '[JSON] ChecklistEntryRead
:<|> "entries" :> ReqBody '[JSON] ApiChecklistEntryWrite :> Post '[JSON] ChecklistEntryRead
:<|> "questions" :> Get '[JSON] [ChecklistQuestionRead]
:<|> "entries" :> Capture "entryId" Int :> "answers" :> Get '[JSON] [Value]
checklistAPI :: Servant.Proxy ChecklistAPI
checklistAPI = Servant.Proxy
checklistServer :: JWTUser -> Int -> ServerT ChecklistAPI AppM
checklistServer jwtUser checklistId' = getChecklist jwtUser checklistId'
:<|> updateChecklist jwtUser checklistId'
:<|> getChecklistEntries jwtUser checklistId'
:<|> getChecklistEntry jwtUser checklistId'
:<|> createChecklistEntry jwtUser checklistId'
:<|> getChecklistQuestions jwtUser checklistId'
:<|> getChecklistAnswers jwtUser checklistId'
getChecklist :: JWTUser -> Int -> AppM ChecklistRead
getChecklist _ = singleQuery . checklistQuery
updateChecklist :: JWTUser -> Int -> TemplateChecklist -> AppM ChecklistRead
updateChecklist jwtUser checklistId' template' = withTransaction $ do
case validate template' of
Success ->
go
Failure es ->
throwError $ err422 { errBody = encode $ Errors { errors = es } }
where
go = do
originalChecklist <- singleQuery (checklistQuery checklistId')
let facilityId' = facilityId (originalChecklist :: ChecklistRead)
checklistWrite = ChecklistWrite { facilityId = facilityId'
, name = name (template' :: TemplateChecklist)
}
updatedChecklist <- liftIO . checklistToPG $ checklistWrite
result <- update
jwtUser
(Just facilityId')
checklistTable
(\_ -> updatedChecklist { Models.Checklist.checklistId = Just $ O.pgInt4 checklistId' })
(\org -> (Models.Checklist.checklistId org) O..== O.pgInt4 checklistId')
case result of
Left err ->
handleSqlError (keyToField template') err
Right savedChecklist -> do
updateQuestions savedChecklist
return savedChecklist
updateQuestions savedChecklist = do
let facilityId' = facilityId (savedChecklist :: ChecklistRead)
now <- liftIO getCurrentTime
archivePreviousQuestions now facilityId'
mapM_ (createQuestion savedChecklist now) $ questions template'
return ()
createQuestion :: ChecklistRead -> UTCTime -> TemplateQuestion -> AppM ChecklistQuestionRead
createQuestion savedChecklist now question' = do
let facilityId' = facilityId (savedChecklist :: ChecklistRead)
newChecklistQuestion <-
liftIO . checklistQuestionToPG now $ ChecklistQuestionWrite
(checklistId (savedChecklist :: ChecklistRead))
(question (question' :: TemplateQuestion))
(description (question' :: TemplateQuestion))
(questionType (question' :: TemplateQuestion))
(position (question' :: TemplateQuestion))
createOr500
(keyToField template')
jwtUser
(Just facilityId')
checklistQuestionTable
newChecklistQuestion
archivePreviousQuestions now facilityId' = do
previousQuestions <- query (checklistQuestionsByChecklistAndTimeQuery checklistId' now)
mapM_ (archiveQuestion now facilityId') previousQuestions
archiveQuestion :: UTCTime -> Int -> ChecklistQuestionRead -> AppM ChecklistQuestionRead
archiveQuestion now facilityId' question' = do
updatedQuestion <- liftIO . checklistQuestionReadToWrite $ question'
updateOr500 (keyToField template') jwtUser (Just facilityId') checklistQuestionTable
(\_ -> updatedQuestion { effectiveTo = O.pgUTCTime now })
(\q -> Models.ChecklistQuestion.checklistQuestionId q O..== O.pgInt4 (Models.ChecklistQuestion.checklistQuestionId question'))
getChecklistEntry :: JWTUser -> Int -> Int -> AppM ChecklistEntryRead
getChecklistEntry _ _ = singleQuery . checklistEntryQuery
getChecklistEntries :: JWTUser -> Int -> AppM [ChecklistEntryRead]
getChecklistEntries _ = query . checklistEntryByChecklistQuery
getChecklistQuestions :: JWTUser -> Int -> AppM [ChecklistQuestionRead]
getChecklistQuestions _ checklistId' =
query . checklistQuestionsByChecklistAndTimeQuery checklistId' =<< liftIO getCurrentTime
getChecklistAnswers :: JWTUser -> Int -> Int -> AppM [Value]
getChecklistAnswers _ _ id =
fmap buildJson <$> (query $ checklistAnswersWithQuestionForChecklistEntryQuery id)
where
buildJson :: (ChecklistAnswerRead, ChecklistQuestionRead) -> Value
buildJson (a, q) =
let
Object jsonAnswer = toJSON a
jsonQuestion = toJSON q
in
Object (M.insert "checklistQuestion" jsonQuestion jsonAnswer)
createChecklistEntry :: JWTUser -> Int -> ApiChecklistEntryWrite -> AppM ChecklistEntryRead
createChecklistEntry jwtUser cId checklistEntryWrite = do
checklist <- singleQuery (checklistQuery cId) :: AppM ChecklistRead
withTransaction $ validateAndCreate (go $ facilityId (checklist :: ChecklistRead)) checklistEntryWrite
where
go facId = do
newChecklistEntry <- liftIO . checklistEntryToPG $ ChecklistEntryWrite cId
savedChecklistEntry <- create jwtUser (Just facId) checklistEntryTable newChecklistEntry
case savedChecklistEntry of
Right checklistEntry -> do
let newChecklistAnswerPG = checklistAnswerPG $ checklistEntryId (checklistEntry :: ChecklistEntryRead)
createdAnswers <- mapM newChecklistAnswerPG $ answers checklistEntryWrite
results <- mapM (create jwtUser (Just facId) checklistAnswerTable) createdAnswers :: AppM [DbResult ChecklistAnswerRead]
case all isRight results of
True ->
return checklistEntry
False ->
throwError $ err500 { errBody = "one or more answers failed to save" }
Left _ ->
throwError err500
checklistAnswerPG entryId apiAnswer =
case answer (apiAnswer :: ApiAnswer) of
Just a ->
liftIO $ checklistAnswerToPG $ ChecklistAnswerWrite { checklistEntryId = entryId
, checklistQuestionId = questionId apiAnswer
, answer = boolToText a
}
Nothing ->
throwError $ err500 { errBody = "got a null answer, validations should have happened by now" }
boolToText :: Bool -> Text
boolToText True = "true"
boolToText False = "false"