stylish-haskell

.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

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
 
 --------------------------------------------------------------------------------

pkg/hs-urbit/lib/Noun/Atom.hs

@@ -17,21 +17,21 @@ 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 -----------------------------------------------------------------------

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
 

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 -----------------------------------------------------------------------

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)

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,7 +129,7 @@ writeWord wor = do
     S{..} <- getS
     setReg (reg .|. shiftL wor off)
     flush
-    update \s -> s { pos = 64 + pos
+    update $ \s -> s { pos = 64 + pos
                      , reg = shiftR wor (64 - off)
                      }
 
@@ -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)
 

pkg/hs-urbit/lib/Noun/TH.hs

@@ -5,9 +5,9 @@
 module Noun.TH (deriveNoun) where
 
 import ClassyPrelude              hiding (fromList)
-import Noun.Convert
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
+import Noun.Convert
 
 import RIO (decodeUtf8Lenient)
 

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
@@ -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 ()

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 ------------------------------------------------------------------

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 -----------------------------------------------------------------------

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 -----------------------------------------------------------------

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

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)
 
 --------------------------------------------------------------------------------
 

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

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

pkg/hs-urbit/lib/Vere/Pier/Types.hs

@@ -1,8 +1,8 @@
 module Vere.Pier.Types where
 
 import ClassyPrelude
-import Noun
 import Database.LMDB.Raw
+import Noun
 import Urbit.Time
 
 import qualified Vere.Ames        as Ames

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