Satisfy hlint

This commit is contained in:
Joscha 2019-12-03 23:24:12 +00:00
parent 616a991e21
commit bbd0707a6d
14 changed files with 46 additions and 54 deletions

View file

@ -4,6 +4,7 @@ module Main where
import Control.Monad.Trans.Class
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Options.Applicative
@ -27,10 +28,7 @@ data Settings = Settings
} deriving (Show)
getOutfile :: Settings -> FilePath
getOutfile settings =
case outfile settings of
Just path -> path
Nothing -> discoveredPath
getOutfile settings = fromMaybe discoveredPath $ outfile settings
where
discoveredPath = dropExtension (infile settings) ++ ".mima"
@ -38,9 +36,9 @@ getFlagFile :: Settings -> File
getFlagFile settings =
case flagFile settings of
Just path -> RequiredFile path
Nothing -> case discover settings of
False -> NoFile
True -> OptionalFile discoveredPath
Nothing -> if discover settings
then OptionalFile discoveredPath
else NoFile
where
discoveredPath = dropExtension (getOutfile settings) ++ ".mima-flags"
@ -48,9 +46,9 @@ getSymbolFile :: Settings -> File
getSymbolFile settings =
case symbolFile settings of
Just path -> RequiredFile path
Nothing -> case discover settings of
False -> NoFile
True -> OptionalFile discoveredPath
Nothing -> if discover settings
then OptionalFile discoveredPath
else NoFile
where
discoveredPath = dropExtension (getOutfile settings) ++ ".mima-symbols"

View file

@ -41,9 +41,9 @@ getFlagFile :: Settings -> File
getFlagFile settings =
case flagFile settings of
Just path -> RequiredFile path
Nothing -> case discover settings of
False -> NoFile
True -> OptionalFile discoveredPath
Nothing -> if discover settings
then OptionalFile discoveredPath
else NoFile
where
discoveredPath = dropExtension (infile settings) ++ ".mima-flags"
@ -51,9 +51,9 @@ getSymbolFile :: Settings -> File
getSymbolFile settings =
case symbolFile settings of
Just path -> RequiredFile path
Nothing -> case discover settings of
False -> NoFile
True -> OptionalFile discoveredPath
Nothing -> if discover settings
then OptionalFile discoveredPath
else NoFile
where
discoveredPath = dropExtension (infile settings) ++ ".mima-symbols"

View file

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Mima.Flag
@ -122,7 +121,7 @@ getFlagSpec af =
isInSet f s = flagChar f `Set.member` s
getAddressSpec :: Flag -> AddressSpec
getAddressSpec f = rangesToSpec $ map fst $ filter (isInSet f . snd) $ Map.assocs af
in pure getAddressSpec <*> rawFlags
in getAddressSpec <$> rawFlags
interpretFlagSpec :: FlagSpec -> Flags (MimaAddress -> Bool)
interpretFlagSpec spec =

View file

@ -113,9 +113,9 @@ fAddress :: MimaAddress -> Formatter
fAddress a = do
env <- ask
let conf = feConf env
dec = if fcShowAddressDec conf then [fAddressDec] else []
hex = if fcShowAddressHex conf then [fAddressHex] else []
bin = if fcShowAddressBin conf then [fAddressBin] else []
dec = [fAddressDec | fcShowAddressDec conf]
hex = [fAddressHex | fcShowAddressHex conf]
bin = [fAddressBin | fcShowAddressBin conf]
formats = (dec ++ hex ++ bin) <*> pure a
pure $ "[" <> T.intercalate ", " formats <> "]"
@ -134,9 +134,9 @@ fWord :: MimaWord -> Formatter
fWord a = do
env <- ask
let conf = feConf env
dec = if fcShowWordDec conf then [fWordDec] else []
hex = if fcShowWordHex conf then [fWordHex] else []
bin = if fcShowWordBin conf then [fWordBin] else []
dec = [fWordDec | fcShowWordDec conf]
hex = [fWordHex | fcShowWordHex conf]
bin = [fWordBin | fcShowWordBin conf]
formats = (dec ++ hex ++ bin) <*> pure a
pure $ "{" <> T.intercalate ", " formats <> "}"

View file

@ -112,8 +112,8 @@ parseSmallInstruction mw = do
parseSmallOpcode :: Opcode -> Either T.Text SmallOpcode
parseSmallOpcode w = case smallOpcodeMap Map.!? w of
Just oc -> pure oc
Nothing -> Left $ "Unknown small opcode " <> toDec w <> " (" <> (fixWidthHex 1 $ toHex w)
<> ", " <> (fixWidthBin 4 $ toBin w) <> ")"
Nothing -> Left $ "Unknown small opcode " <> toDec w <> " (" <> fixWidthHex 1 (toHex w)
<> ", " <> fixWidthBin 4 (toBin w) <> ")"
parseLargeInstruction :: MimaWord -> Either T.Text Instruction
parseLargeInstruction mw = do
@ -125,8 +125,8 @@ parseLargeInstruction mw = do
parseLargeOpcode :: Opcode -> Either T.Text LargeOpcode
parseLargeOpcode w = case largeOpcodeMap Map.!? w of
Just oc -> pure oc
Nothing -> Left $ "Unknown large opcode " <> toDec w <> " (" <> (fixWidthHex 1 $ toHex w)
<> ", " <> (fixWidthBin 4 $ toBin w) <> ")"
Nothing -> Left $ "Unknown large opcode " <> toDec w <> " (" <> fixWidthHex 1 (toHex w)
<> ", " <> fixWidthBin 4 (toBin w) <> ")"
instructionToWord :: Instruction -> MimaWord
instructionToWord (SmallInstruction so lv) = wordFromSmallOpcode (smallOpcodeNr so) lv

View file

@ -29,11 +29,11 @@ instance Binary (LD MimaWord) where
instance Binary (LD LargeValue) where
put = put . LD . largeValueToWord . unLD
get = (LD . getLargeValue) <$> unLD <$> get
get = LD . getLargeValue . unLD <$> get
instance Binary (LD MimaMemory) where
put = mapM_ (put . LD) . memoryToWords . unLD
get = (LD . wordsToMemory . map unLD) <$> many get
get = LD . wordsToMemory . map unLD <$> many get
instance Binary (LD MimaState) where
put ldms = do

View file

@ -36,7 +36,7 @@ almostWordToWord (ALiteral w) = w
formatAssembly :: WeedResult MimaAddress -> (MimaState, LabelSpec, RawFlags)
formatAssembly res =
let mem = fmap almostWordToWord $ wrMemory res
let mem = almostWordToWord <$> wrMemory res
s = registersToState (wrRegisters res) (mapToMemory mem)
in (s, wrLabels res, wrFlags res)

View file

@ -66,7 +66,7 @@ lRawInstruction = label "instruction" $ smallInstruction <|> largeInstruction
where
smallInstruction = do
so <- smallOpcode
void $ lSpace
void lSpace
lv <- lexeme address
pure $ RawSmallInstruction so lv
largeInstruction = do

View file

@ -34,8 +34,8 @@ emptyRegisters = Registers
}
registersToState :: Registers MimaAddress -> MimaMemory -> MimaState
registersToState r mem = MimaState (fromMaybe 0 $ rIAR r) (fromMaybe 0 $ rACC r)
(fromMaybe 0 $ rRA r) (fromMaybe 0 $ rSP r) (fromMaybe 0 $ rFP r) mem
registersToState r = MimaState (fromMaybe 0 $ rIAR r) (fromMaybe 0 $ rACC r)
(fromMaybe 0 $ rRA r) (fromMaybe 0 $ rSP r) (fromMaybe 0 $ rFP r)
data AlmostWord a
= AInstruction (RawInstruction a)

View file

@ -141,8 +141,7 @@ turnFlagsOff thing flags = do
{- Weeding at a larger scale -}
weedDirective :: WithOffset a -> Directive Address -> SWeed ()
weedDirective thing d = do
case d of
weedDirective thing d = case d of
DReg sr -> setRegister thing sr
DOrg addr -> setAddressTo thing addr
DLit w -> addAlmostWord thing (ALiteral w)
@ -164,7 +163,7 @@ weedStep thing =
weedStatements :: [WithOffset (Statement Address)] -> Weed WeedError (WeedResult Address)
weedStatements statements = do
result <- execStateT (mapM_ weedStep statements) initialState
when (not $ Set.null $ wsOpenFlags result)
unless (Set.null $ wsOpenFlags result)
$ harmless
$ errorAt' (lastOffset statements)
$ "Flags were never closed: " ++ T.unpack (formatFlagSet (wsOpenFlags result))

View file

@ -41,4 +41,4 @@ parseFlagFile :: Parser RawFlags
parseFlagFile = space *> many lNewline *> (Map.fromList <$> many lLine) <* hidden eof
readFlagFile :: FilePath -> T.Text -> Either WeedErrorBundle RawFlags
readFlagFile filename input = parse parseFlagFile filename input
readFlagFile = parse parseFlagFile

View file

@ -1,5 +1,3 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Mima.Parse.Weed
( Weed
, runWeed
@ -94,7 +92,7 @@ withOffset :: Parser a -> Parser (WithOffset a)
withOffset p = WithOffset <$> getOffset <*> p
errorAt :: WithOffset a -> String -> WeedError
errorAt wo errorMsg = errorAt' (woOffset wo) errorMsg
errorAt wo = errorAt' (woOffset wo)
errorAt' :: Int -> String -> WeedError
errorAt' o errorMsg = errorsAt' o [errorMsg]

View file

@ -45,10 +45,10 @@ wordsToMemory = mapToMemory
. zip [minBound..]
memoryToWords :: MimaMemory -> [MimaWord]
memoryToWords mem = map (\addr -> readAt addr mem) $ continuousUsedAddresses mem
memoryToWords mem = map (`readAt` mem) $ continuousUsedAddresses mem
maxAddress :: MimaMemory -> MimaAddress
maxAddress (MimaMemory m) = fromMaybe minBound $ fst <$> Map.lookupMax m
maxAddress (MimaMemory m) = maybe minBound fst $ Map.lookupMax m
usedAddresses :: MimaMemory -> [MimaAddress]
usedAddresses (MimaMemory m) = Map.keys m
@ -178,7 +178,7 @@ step' :: Flags (MimaAddress -> Bool) -> MimaState -> Either AbortReason MimaStat
step' flags ms = runExecution flags $ step ms
run :: Flags (MimaAddress -> Bool) -> MimaState -> (MimaState, AbortReason, Integer)
run f ms = helper 0 ms
run f = helper 0
where
helper completed s =
case step' f s of
@ -186,7 +186,7 @@ run f ms = helper 0 ms
Right s' -> helper (completed + 1) s'
runN :: Flags (MimaAddress -> Bool) -> Integer -> MimaState -> (MimaState, Maybe AbortReason, Integer)
runN f n ms = helper 0 ms
runN f n = helper 0
where
helper completed s =
if completed >= n

View file

@ -1,6 +1,4 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Mima.Util
(