stylish-haskell

This commit is contained in:
Benjamin Summers 2019-07-12 12:24:44 -07:00
parent 2d2029106b
commit c474a94d13
22 changed files with 168 additions and 89 deletions

84
.stylish-haskell.yaml Normal file
View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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