diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml new file mode 100644 index 0000000000..87cb1a4bbb --- /dev/null +++ b/.stylish-haskell.yaml @@ -0,0 +1,84 @@ +steps: + # Convert some ASCII sequences to their Unicode equivalents. This is disabled + # by default. + # - unicode_syntax: + # # In order to make this work, we also need to insert the UnicodeSyntax + # # language pragma. If this flag is set to true, we insert it when it's + # # not already present. You may want to disable it if you configure + # # language extensions using some other method than pragmas. Default: + # # true. + # add_language_pragma: true + + - simple_align: + cases: true + top_level_patterns: true + records: true + + # Import cleanup + - imports: + align: group + list_align: after_alias + pad_module_names: true + long_list_align: inline + empty_list_align: inherit + list_padding: 4 + separate_lists: false + space_surround: false + + - language_pragmas: + style: vertical + align: true + remove_redundant: true + + - tabs: + spaces: 4 + + - trailing_whitespace: {} + + # squash: {} + +columns: 80 + +newline: lf + +language_extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns diff --git a/pkg/hs-urbit/lib/Noun.hs b/pkg/hs-urbit/lib/Noun.hs index dda9aa5526..d6408bfaab 100644 --- a/pkg/hs-urbit/lib/Noun.hs +++ b/pkg/hs-urbit/lib/Noun.hs @@ -12,12 +12,12 @@ module Noun import ClassyPrelude import Control.Lens -import Noun.Core -import Noun.Convert -import Noun.Conversions import Noun.Atom -import Noun.Jam +import Noun.Conversions +import Noun.Convert +import Noun.Core import Noun.Cue +import Noun.Jam import Noun.TH -------------------------------------------------------------------------------- diff --git a/pkg/hs-urbit/lib/Noun/Atom.hs b/pkg/hs-urbit/lib/Noun/Atom.hs index 88dd6807d6..d4f98dbe4e 100644 --- a/pkg/hs-urbit/lib/Noun/Atom.hs +++ b/pkg/hs-urbit/lib/Noun/Atom.hs @@ -13,25 +13,25 @@ module Noun.Atom ) where import ClassyPrelude -import Control.Lens hiding (Index) +import Control.Lens hiding (Index) import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import GHC.Exts (sizeofByteArray#) +import GHC.Int (Int(..)) import GHC.Integer.GMP.Internals (BigNat(..), bigNatToWord, sizeofBigNat#) import GHC.Integer.GMP.Internals (indexBigNat#) -import GHC.Integer.GMP.Internals (wordToBigNat, byteArrayToBigNat#, zeroBigNat) -import GHC.Int (Int(..)) +import GHC.Integer.GMP.Internals (byteArrayToBigNat#, wordToBigNat, zeroBigNat) import GHC.Natural (Natural(..)) -import GHC.Prim (plusWord#, clz#, minusWord#) -import GHC.Prim (Word#, subIntC#, timesWord#, int2Word#) +import GHC.Prim (clz#, minusWord#, plusWord#) +import GHC.Prim (Word#, int2Word#, subIntC#, timesWord#) import GHC.Word (Word(..)) import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Primitive.Types as Prim -import qualified Data.Primitive.ByteArray as Prim -import qualified Data.Vector.Primitive as VP import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BU +import qualified Data.Primitive.ByteArray as Prim +import qualified Data.Primitive.Types as Prim +import qualified Data.Vector.Primitive as VP -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs-urbit/lib/Noun/Convert.hs b/pkg/hs-urbit/lib/Noun/Convert.hs index 961448e746..f988d20e96 100644 --- a/pkg/hs-urbit/lib/Noun/Convert.hs +++ b/pkg/hs-urbit/lib/Noun/Convert.hs @@ -7,9 +7,9 @@ module Noun.Convert ) where import ClassyPrelude hiding (hash) -import Noun.Core -import Noun.Atom import Control.Lens +import Noun.Atom +import Noun.Core import qualified Control.Monad.Fail as Fail diff --git a/pkg/hs-urbit/lib/Noun/Core.hs b/pkg/hs-urbit/lib/Noun/Core.hs index 5928835ab5..85a668f077 100644 --- a/pkg/hs-urbit/lib/Noun/Core.hs +++ b/pkg/hs-urbit/lib/Noun/Core.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -funbox-strict-fields #-} -{-# LANGUAGE Strict, StrictData #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} module Noun.Core ( Noun, pattern Cell, pattern Atom, nounSize @@ -14,7 +15,7 @@ import Data.Hashable (hash) import GHC.Natural (Natural) import GHC.Prim (reallyUnsafePtrEquality#) import Test.QuickCheck.Arbitrary (Arbitrary(arbitrary)) -import Test.QuickCheck.Gen (Gen, scale, resize, getSize) +import Test.QuickCheck.Gen (Gen, getSize, resize, scale) -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs-urbit/lib/Noun/Cue.hs b/pkg/hs-urbit/lib/Noun/Cue.hs index 89fd2ac49c..e74cc8de9c 100644 --- a/pkg/hs-urbit/lib/Noun/Cue.hs +++ b/pkg/hs-urbit/lib/Noun/Cue.hs @@ -2,12 +2,12 @@ module Noun.Cue (cue, cueBS) where import ClassyPrelude -import Noun.Core import Noun.Atom +import Noun.Core -import Control.Lens (view, from) -import Data.Bits (shiftL, shiftR, (.|.), (.&.)) -import Foreign.Ptr (Ptr, plusPtr, castPtr, ptrToWordPtr) +import Control.Lens (from, view) +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Foreign.Ptr (Ptr, castPtr, plusPtr, ptrToWordPtr) import Foreign.Storable (peek) import GHC.Prim (ctz#) import GHC.Word (Word(..)) @@ -75,7 +75,7 @@ newtype Get a = Get doGet :: Get a -> ByteString -> Either DecodeExn a doGet m bs = - unsafePerformIO $ try $ BS.unsafeUseAsCStringLen bs \(ptr, len) -> do + unsafePerformIO $ try $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do let endPtr = ptr `plusPtr` len let sz = max 50 $ min 10_000_000 @@ -137,19 +137,19 @@ getPos = Get $ \_ _ s -> pure (GetResult s (pos s)) insRef :: Word -> Noun -> Get () -insRef !pos !now = Get \_ tbl s -> do +insRef !pos !now = Get $ \_ tbl s -> do H.insert tbl pos now pure $ GetResult s () getRef :: Word -> Get Noun -getRef !ref = Get \x tbl s -> do +getRef !ref = Get $ \x tbl s -> do H.lookup tbl ref >>= \case Nothing -> runGet (fail ("Invalid Reference: " <> show ref)) x tbl s Just no -> pure (GetResult s no) advance :: Word -> Get () advance 0 = debugM "advance: 0" >> pure () -advance !n = Get \_ _ s -> do +advance !n = Get $ \_ _ s -> do debugM ("advance: " <> show n) let newUsed = n + usedBits s newS = s { pos = pos s + n @@ -164,7 +164,7 @@ advance !n = Get \_ _ s -> do -- TODO Should this be (>= end) or (> end)? peekCurWord :: Get Word -peekCurWord = Get \end _ s -> do +peekCurWord = Get $ \end _ s -> do debugMId "peekCurWord" $ do if ptrToWordPtr (currPtr s) >= ptrToWordPtr end then pure (GetResult s 0) @@ -172,7 +172,7 @@ peekCurWord = Get \end _ s -> do -- TODO Same question as above. peekNextWord :: Get Word -peekNextWord = Get \end _ s -> do +peekNextWord = Get $ \end _ s -> do debugMId "peekNextWord" $ do let pTarget = currPtr s `plusPtr` 8 if ptrToWordPtr pTarget >= ptrToWordPtr end @@ -182,7 +182,7 @@ peekNextWord = Get \end _ s -> do peekUsedBits :: Get Word peekUsedBits = debugMId "peekUsedBits" $ do - Get \_ _ s -> pure (GetResult s (usedBits s)) + Get $ \_ _ s -> pure (GetResult s (usedBits s)) {-| Get a bit. @@ -219,7 +219,7 @@ dAtomBits :: Word -> Get Atom dAtomBits !(fromIntegral -> bits) = do debugMId ("dAtomBits(" <> show bits <> ")") $ do fmap (view $ from atomWords) $ - VP.generateM bufSize \i -> do + VP.generateM bufSize $ \i -> do debugM (show i) if (i == lastIdx && numExtraBits /= 0) then dWordBits (fromIntegral numExtraBits) diff --git a/pkg/hs-urbit/lib/Noun/Jam.hs b/pkg/hs-urbit/lib/Noun/Jam.hs index 5b9c94d7ba..6e58a3bd5e 100644 --- a/pkg/hs-urbit/lib/Noun/Jam.hs +++ b/pkg/hs-urbit/lib/Noun/Jam.hs @@ -2,18 +2,18 @@ module Noun.Jam (jam, jamBS) where import ClassyPrelude hiding (hash) -import Noun.Core import Noun.Atom +import Noun.Core -import Control.Lens (view, from) -import Data.Bits (shiftL, shiftR, setBit, clearBit, (.|.)) +import Control.Lens (from, view) +import Data.Bits (clearBit, setBit, shiftL, shiftR, (.|.)) import Data.Vector.Primitive ((!)) import Foreign.Marshal.Alloc (callocBytes, free) import Foreign.Ptr (Ptr, castPtr, plusPtr) import Foreign.Storable (poke) -import GHC.Integer.GMP.Internals (BigNat) import GHC.Int (Int(I#)) -import GHC.Natural (Natural(NatS#, NatJ#)) +import GHC.Integer.GMP.Internals (BigNat) +import GHC.Natural (Natural(NatJ#, NatS#)) import GHC.Prim (Word#, plusWord#, word2Int#) import GHC.Word (Word(W#)) import System.IO.Unsafe (unsafePerformIO) @@ -64,7 +64,7 @@ newtype Put a = Put {-# INLINE getRef #-} getRef :: Put (Maybe Word) -getRef = Put \tbl s -> PutResult s <$> H.lookup tbl (pos s) +getRef = Put $ \tbl s -> PutResult s <$> H.lookup tbl (pos s) {- 1. Write the register to the output, and increment the output pointer. @@ -77,15 +77,15 @@ flush = Put $ \tbl s@S{..} -> do {-# INLINE update #-} update :: (S -> S) -> Put () -update f = Put \tbl s@S{..} -> pure (PutResult (f s) ()) +update f = Put $ \tbl s@S{..} -> pure (PutResult (f s) ()) {-# INLINE setRegOff #-} setRegOff :: Word -> Int -> Put () -setRegOff r o = update \s@S{..} -> (s {reg=r, off=o}) +setRegOff r o = update $ \s@S{..} -> (s {reg=r, off=o}) {-# INLINE setReg #-} setReg :: Word -> Put () -setReg r = update \s@S{..} -> (s { reg=r }) +setReg r = update $ \s@S{..} -> (s { reg=r }) {-# INLINE getS #-} getS :: Put S @@ -129,9 +129,9 @@ writeWord wor = do S{..} <- getS setReg (reg .|. shiftL wor off) flush - update \s -> s { pos = 64 + pos - , reg = shiftR wor (64 - off) - } + update $ \s -> s { pos = 64 + pos + , reg = shiftR wor (64 - off) + } {- To write some bits (< 64) from a word: @@ -182,7 +182,7 @@ writeAtomWord (W# w) = writeAtomWord# w writeAtomBigNat :: BigNat -> Put () writeAtomBigNat !(view bigNatWords -> words) = do let lastIdx = VP.length words - 1 - for_ [0..(lastIdx-1)] \i -> + for_ [0..(lastIdx-1)] $ \i -> writeWord (words ! i) writeAtomWord (words ! lastIdx) diff --git a/pkg/hs-urbit/lib/Noun/TH.hs b/pkg/hs-urbit/lib/Noun/TH.hs index e09f62264f..652feaa625 100644 --- a/pkg/hs-urbit/lib/Noun/TH.hs +++ b/pkg/hs-urbit/lib/Noun/TH.hs @@ -4,10 +4,10 @@ module Noun.TH (deriveNoun) where -import ClassyPrelude hiding (fromList) -import Noun.Convert +import ClassyPrelude hiding (fromList) import Language.Haskell.TH import Language.Haskell.TH.Syntax +import Noun.Convert import RIO (decodeUtf8Lenient) diff --git a/pkg/hs-urbit/lib/Urbit/Ames.hs b/pkg/hs-urbit/lib/Urbit/Ames.hs index 6de89654a1..5a82288aea 100644 --- a/pkg/hs-urbit/lib/Urbit/Ames.hs +++ b/pkg/hs-urbit/lib/Urbit/Ames.hs @@ -5,8 +5,8 @@ module Urbit.Ames where import ClassyPrelude import Data.IP -import Noun import Network.Socket +import Noun import qualified Data.Vector as V import qualified Urbit.Time as Time @@ -17,11 +17,11 @@ import qualified Vere.Ames as VA data GalaxyInfo = GalaxyInfo { ip :: IPv4, age :: Time.Unix } data Ames = Ames - { live :: Bool -- ^ whether the listener is on - , ourPort :: Maybe Int + { live :: Bool -- ^ whether the listener is on + , ourPort :: Maybe Int -- , threadId :: Thread , globalDomain :: Maybe Text -- ^ something like "urbit.org" - , imperial :: V.Vector (Maybe GalaxyInfo) + , imperial :: V.Vector (Maybe GalaxyInfo) } init :: Ames @@ -52,7 +52,7 @@ ioStart ames isLocal defaultPort (Atom who) = do -- TODO: set up another thread to own the recv socket, which makes the Ovums -- which get put into the computeQueue, like in _ames_recv_cb. - withSocketsDo do + withSocketsDo $ do s <- socket AF_INET Datagram 17 -- bind s (SockAddrInet port ) pure () diff --git a/pkg/hs-urbit/lib/Urbit/Behn.hs b/pkg/hs-urbit/lib/Urbit/Behn.hs index a2555ddb88..c9a6c882f8 100644 --- a/pkg/hs-urbit/lib/Urbit/Behn.hs +++ b/pkg/hs-urbit/lib/Urbit/Behn.hs @@ -16,18 +16,15 @@ until a new time has been set. -} -module Urbit.Behn (Behn, init, wait, doze) where +module Urbit.Behn (Behn(..), init, wait, doze) where -import Prelude hiding (init) import Control.Lens +import Prelude hiding (init) -import Control.Concurrent.MVar (MVar, takeMVar, newEmptyMVar, putMVar) -import Control.Monad (void, when) -import Data.IORef (IORef, writeIORef, readIORef, newIORef) +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar) -import qualified Urbit.Timer as Timer import qualified Urbit.Time as Time -import qualified GHC.Event as Ev +import qualified Urbit.Timer as Timer -- Behn Stuff ------------------------------------------------------------------ diff --git a/pkg/hs-urbit/lib/Urbit/Time.hs b/pkg/hs-urbit/lib/Urbit/Time.hs index a743f4c482..39fa18c3be 100644 --- a/pkg/hs-urbit/lib/Urbit/Time.hs +++ b/pkg/hs-urbit/lib/Urbit/Time.hs @@ -2,15 +2,15 @@ module Urbit.Time where -import Prelude import Control.Lens +import Prelude -import Noun (FromNoun, ToNoun) import Data.Bits (shiftL, shiftR) import Data.Time.Clock (DiffTime, UTCTime) -import Data.Time.Clock (picosecondsToDiffTime, diffTimeToPicoseconds) +import Data.Time.Clock (diffTimeToPicoseconds, picosecondsToDiffTime) import Data.Time.Clock.System (SystemTime(..), getSystemTime) -import Data.Time.Clock.System (utcToSystemTime, systemToUTCTime) +import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime) +import Noun (FromNoun, ToNoun) -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs-urbit/lib/Urbit/Timer.hs b/pkg/hs-urbit/lib/Urbit/Timer.hs index 1559feb8d4..5a9c3eb68c 100644 --- a/pkg/hs-urbit/lib/Urbit/Timer.hs +++ b/pkg/hs-urbit/lib/Urbit/Timer.hs @@ -1,16 +1,12 @@ -module Urbit.Timer ( Timer, init, stop, start +module Urbit.Timer ( Timer(..), init, stop, start , Sys.getSystemTime, sysTimeGapMicroSecs ) where -import Prelude hiding (init) -import Control.Lens import Data.IORef +import Prelude hiding (init) -import Control.Concurrent.MVar (MVar, takeMVar, newEmptyMVar, putMVar) -import Control.Monad (void, when) - -import qualified GHC.Event as Ev import qualified Data.Time.Clock.System as Sys +import qualified GHC.Event as Ev -- Timer Stuff ----------------------------------------------------------------- diff --git a/pkg/hs-urbit/lib/Vere/Ames.hs b/pkg/hs-urbit/lib/Vere/Ames.hs index 5dc781445c..d24c68eb46 100644 --- a/pkg/hs-urbit/lib/Vere/Ames.hs +++ b/pkg/hs-urbit/lib/Vere/Ames.hs @@ -5,7 +5,7 @@ import Data.IP import Data.Void import Noun -import qualified Urbit.Time as Time +import qualified Urbit.Time as Time type Packet = ByteString diff --git a/pkg/hs-urbit/lib/Vere/Http.hs b/pkg/hs-urbit/lib/Vere/Http.hs index 235748e29e..d3d68c6579 100644 --- a/pkg/hs-urbit/lib/Vere/Http.hs +++ b/pkg/hs-urbit/lib/Vere/Http.hs @@ -5,8 +5,8 @@ module Vere.Http where import ClassyPrelude import Noun -import qualified Data.CaseInsensitive as CI -import qualified Network.HTTP.Types as HT +import qualified Data.CaseInsensitive as CI +import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types.Method as H -------------------------------------------------------------------------------- @@ -26,7 +26,7 @@ data Request = Request data ResponseHeader = ResponseHeader { statusCode :: Word - , headers :: [Header] + , headers :: [Header] } deriving (Eq, Ord, Show) diff --git a/pkg/hs-urbit/lib/Vere/Http/Client.hs b/pkg/hs-urbit/lib/Vere/Http/Client.hs index 768f7b6e4f..f5fa5d37b4 100644 --- a/pkg/hs-urbit/lib/Vere/Http/Client.hs +++ b/pkg/hs-urbit/lib/Vere/Http/Client.hs @@ -50,7 +50,7 @@ cvtReq r = H.requestBody = H.RequestBodyBS $ case body r of Nothing -> "" - Just b -> b + Just b -> b } cvtRespHeaders :: H.Response a -> ResponseHeader diff --git a/pkg/hs-urbit/lib/Vere/Http/Server.hs b/pkg/hs-urbit/lib/Vere/Http/Server.hs index e49050f692..04060d3ad0 100644 --- a/pkg/hs-urbit/lib/Vere/Http/Server.hs +++ b/pkg/hs-urbit/lib/Vere/Http/Server.hs @@ -8,7 +8,7 @@ import Control.Lens import Noun import Vere.Http -import Control.Concurrent (ThreadId, killThread, forkIO) +import Control.Concurrent (ThreadId, forkIO, killThread) import qualified Data.ByteString as BS import qualified Network.HTTP.Types as H @@ -110,7 +110,7 @@ app s req respond = bracket_ cookMeth :: W.Request -> Maybe Method cookMeth re = case H.parseMethod (W.requestMethod re) of - Left _ -> Nothing + Left _ -> Nothing Right m -> Just m data Octs = Octs Atom Atom diff --git a/pkg/hs-urbit/lib/Vere/Isle.hs b/pkg/hs-urbit/lib/Vere/Isle.hs index f18d90af6d..bb23d63d7a 100644 --- a/pkg/hs-urbit/lib/Vere/Isle.hs +++ b/pkg/hs-urbit/lib/Vere/Isle.hs @@ -1,15 +1,16 @@ +{-# OPTIONS_GHC -Wwarn #-} + module Vere.Isle where import ClassyPrelude import Data.Word -import qualified Vere.Isle.Util as C -import qualified SDL as SDL import qualified Data.Vector as V +import qualified SDL as SDL +import qualified Vere.Isle.Util as C import Data.Bits (testBit) import Data.Vector ((!)) -import Data.Flat (Flat) -------------------------------------------------------------------------------- diff --git a/pkg/hs-urbit/lib/Vere/Isle/Util.hs b/pkg/hs-urbit/lib/Vere/Isle/Util.hs index b99334e4c8..f76d439e2f 100644 --- a/pkg/hs-urbit/lib/Vere/Isle/Util.hs +++ b/pkg/hs-urbit/lib/Vere/Isle/Util.hs @@ -63,13 +63,13 @@ isContinue = maybe True (not . isQuitEvent) conditionallyRun :: (Monad m) => m a -> Bool -> m Bool -conditionallyRun f True = True <$ f +conditionallyRun f True = True <$ f conditionallyRun _ False = pure False isQuitEvent :: SDL.Event -> Bool isQuitEvent (SDL.Event _t SDL.QuitEvent) = True -isQuitEvent _ = False +isQuitEvent _ = False setHintQuality :: (MonadIO m) => m () diff --git a/pkg/hs-urbit/lib/Vere/Log.hs b/pkg/hs-urbit/lib/Vere/Log.hs index 8fda8daf83..c822d46945 100644 --- a/pkg/hs-urbit/lib/Vere/Log.hs +++ b/pkg/hs-urbit/lib/Vere/Log.hs @@ -106,7 +106,7 @@ readEvents (EventLog env) first len = found <- mdb_cursor_get MDB_SET_KEY cur pKey pVal assertErr found "mdb could not read initial event of sequence" - vec <- V.generateM (int len) \i -> do + vec <- V.generateM (int len) $ \i -> do key <- peek pKey >>= mdbValToWord64 val <- peek pVal >>= mdbValToAtom @@ -114,7 +114,7 @@ readEvents (EventLog env) first len = assertErr (key == idx) ("missing event in database " <> (show idx)) - when (i + 1 /= (int len)) do + when (i + 1 /= (int len)) $ do found <- mdb_cursor_get MDB_NEXT cur pKey pVal assertErr found "lmdb: next event not found" @@ -141,7 +141,7 @@ maybeErr Nothing msg = error msg byteStringAsMdbVal :: ByteString -> (MDB_val -> IO a) -> IO a byteStringAsMdbVal bs k = - BU.unsafeUseAsCStringLen bs \(ptr,sz) -> + BU.unsafeUseAsCStringLen bs $ \(ptr,sz) -> k (MDB_val (fromIntegral sz) (castPtr ptr)) mdbValToWord64 :: MDB_val -> IO Word64 @@ -163,7 +163,7 @@ withWordPtr w cb = do get :: MDB_txn -> MDB_dbi -> ByteString -> IO Noun get txn db key = - byteStringAsMdbVal key \mKey -> + byteStringAsMdbVal key $ \mKey -> mdb_get txn db mKey >>= maybe (error "mdb bad get") mdbValToNoun mdbValToAtom :: MDB_val -> IO Atom diff --git a/pkg/hs-urbit/lib/Vere/Persist.hs b/pkg/hs-urbit/lib/Vere/Persist.hs index 8a6678f59b..9402358184 100644 --- a/pkg/hs-urbit/lib/Vere/Persist.hs +++ b/pkg/hs-urbit/lib/Vere/Persist.hs @@ -8,9 +8,9 @@ module Vere.Persist (start, stop) where import ClassyPrelude hiding (init) +import Database.LMDB.Raw import Vere.Log import Vere.Pier.Types -import Database.LMDB.Raw -- Types ----------------------------------------------------------------------- @@ -45,7 +45,7 @@ persistThread :: EventLog -> (Writ [Eff] -> STM ()) -> IO () persistThread (EventLog env) inputQueue onPersist = - forever do + forever $ do writs <- atomically $ readQueue inputQueue writeEvents writs atomically $ traverse_ onPersist writs diff --git a/pkg/hs-urbit/lib/Vere/Pier/Types.hs b/pkg/hs-urbit/lib/Vere/Pier/Types.hs index a0084fa0b5..bd1b08aaf9 100644 --- a/pkg/hs-urbit/lib/Vere/Pier/Types.hs +++ b/pkg/hs-urbit/lib/Vere/Pier/Types.hs @@ -1,11 +1,11 @@ module Vere.Pier.Types where import ClassyPrelude -import Noun import Database.LMDB.Raw +import Noun import Urbit.Time -import qualified Vere.Ames as Ames +import qualified Vere.Ames as Ames import qualified Vere.Http.Client as Client import qualified Vere.Http.Server as Server diff --git a/pkg/hs-urbit/lib/Vere/Serf.hs b/pkg/hs-urbit/lib/Vere/Serf.hs index 80d34e495a..73f9fe78a4 100644 --- a/pkg/hs-urbit/lib/Vere/Serf.hs +++ b/pkg/hs-urbit/lib/Vere/Serf.hs @@ -14,7 +14,7 @@ import Data.ByteString (hGet) import Data.ByteString.Unsafe (unsafeUseAsCString) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) -import Foreign.Storable (poke, peek) +import Foreign.Storable (peek, poke) import System.Exit (ExitCode) import qualified Data.ByteString.Unsafe as BS @@ -220,7 +220,7 @@ replayEvents w (wid, wmug) identity lastCommitedId getEvents = do loop vLast curEvent = do traceM ("replayEvents.loop: " <> show curEvent) let toRead = min 1000 (1 + lastCommitedId - curEvent) - when (toRead > 0) do + when (toRead > 0) $ do traceM ("replayEvents.loop.getEvents " <> show toRead) events <- getEvents curEvent toRead @@ -264,7 +264,7 @@ replay w ident lastEv getEvents = do replayEvents w ws ident lastEv getEvents workerThread :: Serf -> STM Ovum -> (EventId, Mug) -> IO (Async ()) -workerThread w getEvent (evendId, mug) = async $ forever do +workerThread w getEvent (evendId, mug) = async $ forever $ do ovum <- atomically $ getEvent currentDate <- Time.now