Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

some linting #1198

Merged
merged 3 commits into from
Apr 19, 2023
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 13 additions & 11 deletions src/Pact/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -151,13 +151,15 @@ reservedAtom = bareAtom >>= \AtomExp{..} -> case HM.lookup _atomAtom reserveds o
Just r -> commit >> return r

compile :: ParseEnv -> MkInfo -> Exp Parsed -> Either PactError (Term Name)
compile pe mi e = let ei = mi <$> e in runCompile pe topLevel (initParseState ei) ei
compile pe mi e = runCompile pe topLevel (initParseState ei) ei
where
ei = mi <$> e

compileExps :: Traversable t => ParseEnv -> MkInfo -> t (Exp Parsed) -> Either PactError (t (Term Name))
compileExps pe mi exps = sequence $ compile pe mi <$> exps
compileExps pe mi exps = mapM (compile pe mi) exps
larskuhtz marked this conversation as resolved.
Show resolved Hide resolved

moduleState :: Compile ModuleState
moduleState = use (psUser . csModule) >>= \m -> case m of
moduleState = use (psUser . csModule) >>= \case
Just m' -> return m'
Nothing -> context >>= tokenErr' "Must be declared within module"

Expand Down Expand Up @@ -213,7 +215,7 @@ cToTV n | n < 26 = fromString [toC n]
where toC i = toEnum (fromEnum 'a' + i)


sexp :: (Compile a) -> Compile a
sexp :: Compile a -> Compile a
sexp body = withList' Parens (body <* eof)

specialFormOrApp :: (Reserved -> Compile (Compile (Term Name))) -> Compile (Term Name)
Expand Down Expand Up @@ -246,7 +248,7 @@ valueLevel = literals <|> varAtom <|> specialFormOrApp valueLevelForm where
_ -> expected "value level form (let, let*, with-capability, cond)"

moduleLevel :: Compile [Term Name]
moduleLevel = specialForm $ \r -> case r of
moduleLevel = specialForm $ \case
RUse -> returnl useForm
RDefconst -> returnl defconst
RBless -> return (bless >> return [])
Expand Down Expand Up @@ -411,7 +413,7 @@ meta modelAllowed =
ModelAllowed -> a
ModelNotAllowed -> unexpected' "@model not allowed in this declaration"
atPairs = do
ps <- sort <$> (some (docPair <|> modelPair))
ps <- sort <$> some (docPair <|> modelPair)
case ps of
[DocPair doc] -> return (Meta (Just doc) [])
[ModelPair es] -> whenModelAllowed $ return (Meta Nothing es)
Expand Down Expand Up @@ -447,7 +449,7 @@ defcapManaged dt = case dt of
_ -> return Nothing
where
doDefcapMeta = symbol "@managed" *>
((DMDefcap . DefcapManaged) <$> (doUserMgd <|> doAuto))
(DMDefcap . DefcapManaged <$> (doUserMgd <|> doAuto))
doUserMgd = Just <$> ((,) <$> (_atomAtom <$> userAtom) <*> userVar)
doAuto = pure Nothing
doEvent = symbol "@event" *> pure (DMDefcap DefcapEvent)
Expand All @@ -458,7 +460,7 @@ defpact = do
(defname,returnTy) <- first _atomAtom <$> typedAtom
args <- withList' Parens $ many arg
m <- meta ModelAllowed
(body,bi) <- bodyForm' $ specialForm $ \r -> case r of
(body,bi) <- bodyForm' $ specialForm $ \case
RStep -> return step
RStepWithRollback -> return stepWithRollback
_ -> expected "step or step-with-rollback"
Expand All @@ -479,7 +481,7 @@ moduleForm = do
modName' <- _atomAtom <$> userAtom
gov <- Governance <$> ((Left <$> keysetNameStr) <|> (Right <$> userVar))
m <- meta ModelAllowed
use (psUser . csModule) >>= \cm -> case cm of
use (psUser . csModule) >>= \case
Just {} -> syntaxError "Invalid nested module or interface"
Nothing -> return ()
i <- contextInfo
Expand All @@ -504,7 +506,7 @@ interface :: Compile (Term Name)
interface = do
iname' <- _atomAtom <$> bareAtom
m <- meta ModelAllowed
use (psUser . csModule) >>= \ci -> case ci of
use (psUser . csModule) >>= \case
Just {} -> syntaxError "invalid nested interface or module"
Nothing -> return ()
info <- contextInfo
Expand All @@ -514,7 +516,7 @@ interface = do
iname = ModuleName iname' Nothing
ihash = ModuleHash . pactHash . encodeUtf8 . _unCode $ code
(bd,ModuleState{..}) <- withModuleState (initModuleState iname ihash) $
bodyForm $ specialForm $ \r -> case r of
bodyForm $ specialForm $ \case
RDefun -> return $ defSig Defun
RDefconst -> return defconst
RUse -> return useForm
Expand Down
3 changes: 1 addition & 2 deletions src/Pact/Types/ExpParser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -120,8 +120,7 @@ mkEmptyInfo e = Info (Just (mempty,e))

{-# INLINE mkStringInfo #-}
mkStringInfo :: String -> MkInfo
mkStringInfo s d = Info (Just (fromString $ take (_pLength d) $
drop (fromIntegral $ TF.bytes d) s,d))
mkStringInfo = mkTextInfo . T.pack
jwiegley marked this conversation as resolved.
Show resolved Hide resolved

{-# INLINE mkTextInfo #-}
mkTextInfo :: T.Text -> MkInfo
Expand Down