diff --git a/.ormolu b/.ormolu new file mode 100644 index 0000000000..fb60d7db30 --- /dev/null +++ b/.ormolu @@ -0,0 +1,4 @@ +infixl 8 ^? +infixr 4 %%~, %~ +infixl 3 <|> +infixl 1 &, <&> diff --git a/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs b/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs index f8f7dc29e0..4085b8d784 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs @@ -10,7 +10,7 @@ import U.Codebase.HashTags import Unison.Hashing.V2 qualified as Hashing import Unison.Hashing.V2.Convert2 (convertBranchV3, v2ToH2Branch) -hashBranch :: forall m. Monad m => Branch m -> m BranchHash +hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash hashBranch branch = BranchHash . Hashing.contentHash <$> v2ToH2Branch branch diff --git a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs index 53b4b72473..3ab63459b7 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs @@ -100,7 +100,7 @@ v2ToH2Referent = \case V2Referent.Ref r -> H2.ReferentRef (v2ToH2Reference r) V2Referent.Con r cid -> H2.ReferentCon (v2ToH2Reference r) cid -v2ToH2Branch :: Monad m => V2.Branch m -> m H2.Branch +v2ToH2Branch :: (Monad m) => V2.Branch m -> m H2.Branch v2ToH2Branch V2.Branch {terms, types, patches, children} = do hterms <- traverse sequenceA terms @@ -166,7 +166,7 @@ hashPatchFormatToH2Patch Memory.PatchFull.Patch {termEdits, typeEdits} = V2Referent.Con typeRef conId -> do (H2.ReferentCon (v2ToH2Reference $ second unComponentHash typeRef) conId) -v2ToH2Term :: forall v. Ord v => V2.Term.HashableTerm v -> H2.Term v () +v2ToH2Term :: forall v. (Ord v) => V2.Term.HashableTerm v -> H2.Term v () v2ToH2Term = ABT.transform convertF where convertF :: V2.Term.F' Text V2.Term.HashableTermRef V2.Term.TypeRef V2.Term.HashableTermLink V2.Term.TypeLink v a1 -> H2.TermF v () () a1 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs index afb2a54c26..c2df6ef2f6 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs @@ -173,7 +173,7 @@ decodeWatchResultFormat = ------------------------------------------------------------------------------------------------------------------------ -- unsyncs -unsyncTermComponent :: HasCallStack => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d) +unsyncTermComponent :: (HasCallStack) => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d) unsyncTermComponent (TermFormat.SyncLocallyIndexedComponent terms) = do let phi (localIds, bs) = do (a, b) <- decodeSyncTermAndType bs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs index 028c4d827f..6c0c264265 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs @@ -39,7 +39,7 @@ data HashHandle = HashHandle toReferenceDecl :: Hash -> C.Type.TypeD Symbol -> C.Reference, -- | Hash decl's mentions toReferenceDeclMentions :: Hash -> C.Type.TypeD Symbol -> Set C.Reference, - hashBranch :: forall m. Monad m => Branch m -> m BranchHash, + hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash, hashBranchV3 :: forall m. BranchV3 m -> BranchHash, hashCausal :: -- The causal's namespace hash diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs index 74228c5d9b..4319249f4b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs @@ -109,23 +109,23 @@ localizePatchG (Patch termEdits typeEdits) = -- General-purpose localization -- Contains references to branch objects. -class Ord c => ContainsBranches c s where +class (Ord c) => ContainsBranches c s where branches_ :: Lens' s (Map c LocalBranchChildId) -- Contains references to definition objects i.e. term/decl component objects. -class Ord d => ContainsDefns d s where +class (Ord d) => ContainsDefns d s where defns_ :: Lens' s (Map d LocalDefnId) -- Contains references to objects by their hash. -class Ord h => ContainsHashes h s where +class (Ord h) => ContainsHashes h s where hashes_ :: Lens' s (Map h LocalHashId) -- Contains references to patch objects. -class Ord p => ContainsPatches p s where +class (Ord p) => ContainsPatches p s where patches_ :: Lens' s (Map p LocalPatchObjectId) -- Contains text. -class Ord t => ContainsText t s where +class (Ord t) => ContainsText t s where texts_ :: Lens' s (Map t LocalTextId) -- The inner state of the localization of a branch object. @@ -137,16 +137,16 @@ data LocalizeBranchState t d p c = LocalizeBranchState } deriving (Show, Generic) -instance Ord t => ContainsText t (LocalizeBranchState t d p c) where +instance (Ord t) => ContainsText t (LocalizeBranchState t d p c) where texts_ = field @"texts" -instance Ord d => ContainsDefns d (LocalizeBranchState t d p c) where +instance (Ord d) => ContainsDefns d (LocalizeBranchState t d p c) where defns_ = field @"defns" -instance Ord p => ContainsPatches p (LocalizeBranchState t d p c) where +instance (Ord p) => ContainsPatches p (LocalizeBranchState t d p c) where patches_ = field @"patches" -instance Ord c => ContainsBranches c (LocalizeBranchState t d p c) where +instance (Ord c) => ContainsBranches c (LocalizeBranchState t d p c) where branches_ = field @"branches" -- | Run a computation that localizes a branch object, returning the local ids recorded within. @@ -171,13 +171,13 @@ data LocalizePatchState t h d = LocalizePatchState } deriving (Show, Generic) -instance Ord t => ContainsText t (LocalizePatchState t h d) where +instance (Ord t) => ContainsText t (LocalizePatchState t h d) where texts_ = field @"texts" -instance Ord h => ContainsHashes h (LocalizePatchState t h d) where +instance (Ord h) => ContainsHashes h (LocalizePatchState t h d) where hashes_ = field @"hashes" -instance Ord d => ContainsDefns d (LocalizePatchState t h d) where +instance (Ord d) => ContainsDefns d (LocalizePatchState t h d) where defns_ = field @"defns" -- Run a computation that localizes a patch object, returning the local ids recorded within. diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs index 2528aa177c..1f91746219 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs @@ -58,7 +58,7 @@ instance (FromRow ref) => FromRow (NamedRef ref) where newtype ScopedRow ref = ScopedRow (NamedRef ref) -instance ToRow ref => ToRow (ScopedRow ref) where +instance (ToRow ref) => ToRow (ScopedRow ref) where toRow (ScopedRow (NamedRef {reversedSegments = revSegments, ref})) = SQLText reversedName : SQLText namespace : SQLText lastNameSegment : toRow ref where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs index b2f1366932..749a87290c 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs @@ -55,7 +55,7 @@ patchT_ f Patch {termEdits, typeEdits} = do newTypeEdits <- traverseOf (Map.bitraversed (Reference.t_) (Set.traverse . traverseFirst)) f typeEdits pure Patch {termEdits = newTermEdits, typeEdits = newTypeEdits} where - traverseFirst :: Bitraversable b => Traversal (b a c) (b a' c) a a' + traverseFirst :: (Bitraversable b) => Traversal (b a c) (b a' c) a a' traverseFirst f = bitraverse f pure patchH_ :: (Ord t, Ord h') => Traversal (Patch' t h o) (Patch' t h' o) h h' diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 241d351574..822cdd125e 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -289,7 +289,7 @@ module U.Codebase.Sqlite.Queries -- * Types NamespaceText, TextPathSegments, - JsonParseFailure(..), + JsonParseFailure (..), ) where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs index 98554c38d1..55c3213f4a 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs @@ -462,7 +462,7 @@ putDeclFormat = \case putDeclComponent (DeclFormat.LocallyIndexedComponent v) = putFramedArray (putPair putLocalIds putDeclElement) v -putDeclElement :: MonadPut m => Decl.DeclR DeclFormat.TypeRef Symbol -> m () +putDeclElement :: (MonadPut m) => Decl.DeclR DeclFormat.TypeRef Symbol -> m () putDeclElement Decl.DataDeclaration {..} = do putDeclType declType putModifier modifier @@ -499,7 +499,7 @@ getDeclElement = 1 -> pure Decl.Effect other -> unknownTag "DeclType" other -getModifier :: MonadGet m => m Modifier +getModifier :: (MonadGet m) => m Modifier getModifier = getWord8 >>= \case 0 -> pure Decl.Structural @@ -720,7 +720,7 @@ getLocalBranch = x -> unknownTag "getMetadataSetFormat" x getBranchDiff' :: - MonadGet m => + (MonadGet m) => m branchRef -> m (BranchFormat.BranchLocalIds' text defRef patchRef childRef) -> m (BranchFormat.BranchFormat' text defRef patchRef childRef branchRef) diff --git a/codebase2/codebase/U/Codebase/Causal.hs b/codebase2/codebase/U/Codebase/Causal.hs index aad0d36fa0..74e4c1fcf0 100644 --- a/codebase2/codebase/U/Codebase/Causal.hs +++ b/codebase2/codebase/U/Codebase/Causal.hs @@ -19,11 +19,11 @@ data Causal m hc he pe e = Causal } deriving stock (Functor, Generic) -instance Eq hc => Eq (Causal m hc he pe e) where +instance (Eq hc) => Eq (Causal m hc he pe e) where (==) = (==) `on` causalHash -- | @emap f g@ maps over the values and parents' values with @f@ and @g@. -emap :: Functor m => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e' +emap :: (Functor m) => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e' emap f g causal@Causal {parents, value} = causal { parents = Map.map (fmap (emap g g)) parents, diff --git a/codebase2/codebase/U/Codebase/Decl.hs b/codebase2/codebase/U/Codebase/Decl.hs index 26172ed1db..7a46ea9fc0 100644 --- a/codebase2/codebase/U/Codebase/Decl.hs +++ b/codebase2/codebase/U/Codebase/Decl.hs @@ -41,11 +41,11 @@ data DeclR r v = DataDeclaration } deriving (Show) -allVars :: Ord v => DeclR r v -> Set v +allVars :: (Ord v) => DeclR r v -> Set v allVars (DataDeclaration _ _ bound constructorTypes) = (Set.fromList $ foldMap ABT.allVars constructorTypes) <> Set.fromList bound -vmap :: Ord v' => (v -> v') -> DeclR r v -> DeclR r v' +vmap :: (Ord v') => (v -> v') -> DeclR r v -> DeclR r v' vmap f (DataDeclaration {declType, modifier, bound, constructorTypes}) = DataDeclaration { declType, @@ -82,7 +82,7 @@ data F a -- to the relevant piece of the component in the component map. unhashComponent :: forall v extra. - ABT.Var v => + (ABT.Var v) => Hash -> -- | A function to convert a reference to a variable. The actual var names aren't important. (Reference.Id -> v) -> diff --git a/codebase2/codebase/U/Codebase/Term.hs b/codebase2/codebase/U/Codebase/Term.hs index 3af9a5faff..57691ba6ec 100644 --- a/codebase2/codebase/U/Codebase/Term.hs +++ b/codebase2/codebase/U/Codebase/Term.hs @@ -207,7 +207,7 @@ extraMapM ftext ftermRef ftypeRef ftermLink ftypeLink fvt = go' rmapPattern :: (t -> t') -> (r -> r') -> Pattern t r -> Pattern t' r' rmapPattern ft fr p = runIdentity . rmapPatternM (pure . ft) (pure . fr) $ p -rmapPatternM :: Applicative m => (t -> m t') -> (r -> m r') -> Pattern t r -> m (Pattern t' r') +rmapPatternM :: (Applicative m) => (t -> m t') -> (r -> m r') -> Pattern t r -> m (Pattern t' r') rmapPatternM ft fr = go where go = \case @@ -260,7 +260,7 @@ dependencies = -- to the relevant piece of the component in the component map. unhashComponent :: forall v extra. - ABT.Var v => + (ABT.Var v) => -- | The hash of the component, this is used to fill in self-references. Hash -> -- | A function to convert a reference to a variable. The actual var names aren't important. diff --git a/codebase2/core/Unison/NameSegment/Internal.hs b/codebase2/core/Unison/NameSegment/Internal.hs index 9ecc1ff43b..a7c108c4a5 100644 --- a/codebase2/core/Unison/NameSegment/Internal.hs +++ b/codebase2/core/Unison/NameSegment/Internal.hs @@ -27,12 +27,13 @@ newtype NameSegment = NameSegment deriving newtype (Alphabetical) instance - TypeError - ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" - ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" - ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" - ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." - ) => + ( TypeError + ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" + ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" + ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" + ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." + ) + ) => IsString NameSegment where fromString = undefined diff --git a/codebase2/core/Unison/Util/Alphabetical.hs b/codebase2/core/Unison/Util/Alphabetical.hs index b87bfea3f7..1c84ead241 100644 --- a/codebase2/core/Unison/Util/Alphabetical.hs +++ b/codebase2/core/Unison/Util/Alphabetical.hs @@ -18,10 +18,10 @@ import Data.Text (Text) class (Eq n) => Alphabetical n where compareAlphabetical :: n -> n -> Ordering -sortAlphabetically :: Alphabetical a => [a] -> [a] +sortAlphabetically :: (Alphabetical a) => [a] -> [a] sortAlphabetically as = (\(OrderAlphabetically a) -> a) <$> List.sort (map OrderAlphabetically as) -sortAlphabeticallyOn :: Alphabetical a => (b -> a) -> [b] -> [b] +sortAlphabeticallyOn :: (Alphabetical a) => (b -> a) -> [b] -> [b] sortAlphabeticallyOn f = List.sortOn (OrderAlphabetically . f) instance Alphabetical Text where diff --git a/codebase2/util-serialization/U/Util/Serialization.hs b/codebase2/util-serialization/U/Util/Serialization.hs index 82d49e1408..2d4f1bd7ae 100644 --- a/codebase2/util-serialization/U/Util/Serialization.hs +++ b/codebase2/util-serialization/U/Util/Serialization.hs @@ -154,7 +154,7 @@ getVector getA = do length <- getVarInt Vector.replicateM length getA -skipVector :: MonadGet m => m a -> m () +skipVector :: (MonadGet m) => m a -> m () skipVector getA = do length <- getVarInt replicateM_ length getA diff --git a/lib/unison-prelude/src/Unison/Prelude.hs b/lib/unison-prelude/src/Unison/Prelude.hs index 0ddd4aee64..374f4a1812 100644 --- a/lib/unison-prelude/src/Unison/Prelude.hs +++ b/lib/unison-prelude/src/Unison/Prelude.hs @@ -102,7 +102,7 @@ import Witch as X (From (from), TryFrom (tryFrom), TryFromException (TryFromExce import Witherable as X (filterA, forMaybe, mapMaybe, wither, witherMap) -- | Can be removed when we upgrade transformers to a more recent version. -hoistMaybe :: Applicative m => Maybe a -> MaybeT m a +hoistMaybe :: (Applicative m) => Maybe a -> MaybeT m a hoistMaybe = MaybeT . pure -- | Like 'fold' but for Alternative. diff --git a/lib/unison-prelude/src/Unison/Util/Map.hs b/lib/unison-prelude/src/Unison/Util/Map.hs index be67d730b3..49cf1e7c36 100644 --- a/lib/unison-prelude/src/Unison/Util/Map.hs +++ b/lib/unison-prelude/src/Unison/Util/Map.hs @@ -41,7 +41,7 @@ import Data.Vector qualified as Vector import Unison.Prelude hiding (bimap, foldM, for_) -- | A common case of @Map.merge@. Like @alignWith@, but includes the key. -alignWithKey :: Ord k => (k -> These a b -> c) -> Map k a -> Map k b -> Map k c +alignWithKey :: (Ord k) => (k -> These a b -> c) -> Map k a -> Map k b -> Map k c alignWithKey f = Map.merge (Map.mapMissing \k x -> f k (This x)) @@ -60,7 +60,7 @@ bitraversed keyT valT f m = -- | Traverse a map as a list of key-value pairs. -- Note: This can have unexpected results if the result contains duplicate keys. -asList_ :: Ord k' => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')] +asList_ :: (Ord k') => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')] asList_ f s = s & Map.toList @@ -73,13 +73,13 @@ swap = Map.foldlWithKey' (\z a b -> Map.insert b a z) mempty -- | Like 'Map.insert', but returns the old value as well. -insertLookup :: Ord k => k -> v -> Map k v -> (Maybe v, Map k v) +insertLookup :: (Ord k) => k -> v -> Map k v -> (Maybe v, Map k v) insertLookup k v = upsertLookup (const v) k -- | Invert a map's keys and values. This probably only makes sense with injective maps, but otherwise, later key/value -- pairs (ordered by the original map's keys) overwrite earlier ones. -invert :: Ord v => Map k v -> Map v k +invert :: (Ord v) => Map k v -> Map v k invert = Map.foldlWithKey' (\m k v -> Map.insert v k m) Map.empty @@ -94,7 +94,7 @@ upsertF f = Map.alterF (fmap Just . f) -- | Like 'upsert', but returns the old value as well. -upsertLookup :: Ord k => (Maybe v -> v) -> k -> Map k v -> (Maybe v, Map k v) +upsertLookup :: (Ord k) => (Maybe v -> v) -> k -> Map k v -> (Maybe v, Map k v) upsertLookup f = upsertF (\v -> (v, f v)) @@ -113,12 +113,12 @@ deleteLookupJust = Map.alterF (maybe (error (reportBug "E525283" "deleteLookupJust: element not found")) (,Nothing)) -- | Like 'Map.elems', but return the values as a set. -elemsSet :: Ord v => Map k v -> Set v +elemsSet :: (Ord v) => Map k v -> Set v elemsSet = Set.fromList . Map.elems -- | Like 'Map.foldlWithKey'', but with a monadic accumulator. -foldM :: Monad m => (acc -> k -> v -> m acc) -> acc -> Map k v -> m acc +foldM :: (Monad m) => (acc -> k -> v -> m acc) -> acc -> Map k v -> m acc foldM f acc0 = go acc0 where @@ -141,7 +141,7 @@ foldMapM f = pure $! Map.insert k v acc -- | Run a monadic action for each key/value pair in a map. -for_ :: Monad m => Map k v -> (k -> v -> m ()) -> m () +for_ :: (Monad m) => Map k v -> (k -> v -> m ()) -> m () for_ m f = go m where diff --git a/lib/unison-prelude/src/Unison/Util/Tuple.hs b/lib/unison-prelude/src/Unison/Util/Tuple.hs index 2a9fbfb52d..c317e41ffc 100644 --- a/lib/unison-prelude/src/Unison/Util/Tuple.hs +++ b/lib/unison-prelude/src/Unison/Util/Tuple.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | Tuple utils. module Unison.Util.Tuple diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs index 7b8a077b20..48167980db 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs @@ -151,7 +151,7 @@ logQuery (Sql sql params) result = -- Without results -execute :: HasCallStack => Connection -> Sql -> IO () +execute :: (HasCallStack) => Connection -> Sql -> IO () execute conn@(Connection _ _ conn0) sql@(Sql s params) = do logQuery sql Nothing doExecute `catch` \(exception :: Sqlite.SQLError) -> @@ -171,7 +171,7 @@ execute conn@(Connection _ _ conn0) sql@(Sql s params) = do -- | Execute one or more semicolon-delimited statements. -- -- This function does not support parameters, and is mostly useful for executing DDL and migrations. -executeStatements :: HasCallStack => Connection -> Text -> IO () +executeStatements :: (HasCallStack) => Connection -> Text -> IO () executeStatements conn@(Connection _ _ (Sqlite.Connection database _tempNameCounter)) sql = do logQuery (Sql sql []) Nothing Direct.Sqlite.exec database sql `catch` \(exception :: Sqlite.SQLError) -> diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs index a573727461..e1473edfc2 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs @@ -138,7 +138,7 @@ data SqliteQueryExceptionInfo = SqliteQueryExceptionInfo exception :: SomeSqliteExceptionReason } -throwSqliteQueryException :: HasCallStack => SqliteQueryExceptionInfo -> IO a +throwSqliteQueryException :: (HasCallStack) => SqliteQueryExceptionInfo -> IO a throwSqliteQueryException SqliteQueryExceptionInfo {connection, exception, sql = Sql sql params} = do threadId <- myThreadId throwIO diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs b/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs index 97ee636022..475cb0318a 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs @@ -193,7 +193,7 @@ sqlQQ input = Nothing -> fail ("Not in scope: " ++ Text.unpack var) Just name -> (,) <$> [|valuesSql $(TH.varE name)|] <*> [|foldMap Sqlite.Simple.toRow $(TH.varE name)|] -inSql :: Sqlite.Simple.ToField a => [a] -> Text +inSql :: (Sqlite.Simple.ToField a) => [a] -> Text inSql scalars = Text.Builder.run ("IN (" <> b_commaSep (map (\_ -> b_qmark) scalars) <> b_rparen) diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs index e40f4a7639..b44a04b0fa 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs @@ -66,11 +66,11 @@ newtype Transaction a -- Omit MonadThrow instance so we always throw SqliteException (via *Check) with lots of context deriving (Applicative, Functor, Monad) via (ReaderT Connection IO) -instance Monoid a => Monoid (Transaction a) where - mempty :: Monoid a => Transaction a +instance (Monoid a) => Monoid (Transaction a) where + mempty :: (Monoid a) => Transaction a mempty = pure mempty -instance Semigroup a => Semigroup (Transaction a) where +instance (Semigroup a) => Semigroup (Transaction a) where (<>) :: Transaction a -> Transaction a -> Transaction a (<>) = liftA2 (<>) @@ -143,7 +143,7 @@ runReadOnlyTransaction conn f = runReadOnlyTransaction_ conn (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runReadOnlyTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runReadOnlyTransaction_ :: HasCallStack => Connection -> IO a -> IO a +runReadOnlyTransaction_ :: (HasCallStack) => Connection -> IO a -> IO a runReadOnlyTransaction_ conn action = do bracketOnError_ (Connection.begin conn) @@ -170,7 +170,7 @@ runWriteTransaction conn f = (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runWriteTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runWriteTransaction_ :: HasCallStack => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a +runWriteTransaction_ :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a runWriteTransaction_ restore conn transaction = do keepTryingToBeginImmediate restore conn result <- restore transaction `onException` ignoringExceptions (Connection.rollback conn) @@ -178,7 +178,7 @@ runWriteTransaction_ restore conn transaction = do pure result -- @BEGIN IMMEDIATE@ until success. -keepTryingToBeginImmediate :: HasCallStack => (forall x. IO x -> IO x) -> Connection -> IO () +keepTryingToBeginImmediate :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO () keepTryingToBeginImmediate restore conn = let loop = try @_ @SqliteQueryException (Connection.beginImmediate conn) >>= \case @@ -217,7 +217,7 @@ savepoint (Transaction action) = do -- transaction needs to retry. -- -- /Warning/: attempting to run a transaction inside a transaction will cause an exception! -unsafeIO :: HasCallStack => IO a -> Transaction a +unsafeIO :: (HasCallStack) => IO a -> Transaction a unsafeIO action = Transaction \_ -> action @@ -232,11 +232,11 @@ unsafeUnTransaction (Transaction action) = -- Without results -execute :: HasCallStack => Sql -> Transaction () +execute :: (HasCallStack) => Sql -> Transaction () execute s = Transaction \conn -> Connection.execute conn s -executeStatements :: HasCallStack => Text -> Transaction () +executeStatements :: (HasCallStack) => Text -> Transaction () executeStatements s = Transaction \conn -> Connection.executeStatements conn s diff --git a/lib/unison-util-bytes/test/Main.hs b/lib/unison-util-bytes/test/Main.hs index 6118703e43..98906571a4 100644 --- a/lib/unison-util-bytes/test/Main.hs +++ b/lib/unison-util-bytes/test/Main.hs @@ -42,10 +42,8 @@ test = scope "<>" . expect' $ Bytes.toArray (b1s <> b2s <> b3s) == b1 <> b2 <> b3 scope "Ord" . expect' $ - (b1 <> b2 <> b3) - `compare` b3 - == (b1s <> b2s <> b3s) - `compare` b3s + (b1 <> b2 <> b3) `compare` b3 + == (b1s <> b2s <> b3s) `compare` b3s scope "take" . expect' $ Bytes.toArray (Bytes.take k (b1s <> b2s)) == BS.take k (b1 <> b2) scope "drop" . expect' $ diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index e970281f07..5700d3f11c 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -62,32 +62,32 @@ data BiMultimap a b = BiMultimap empty :: (Ord a, Ord b) => BiMultimap a b empty = BiMultimap mempty mempty -memberDom :: Ord a => a -> BiMultimap a b -> Bool +memberDom :: (Ord a) => a -> BiMultimap a b -> Bool memberDom x = Map.member x . domain -- | Look up the set of @b@ related to an @a@. -- -- /O(log a)/. -lookupDom :: Ord a => a -> BiMultimap a b -> Set b +lookupDom :: (Ord a) => a -> BiMultimap a b -> Set b lookupDom a = lookupDom_ a . domain -lookupDom_ :: Ord a => a -> Map a (NESet b) -> Set b +lookupDom_ :: (Ord a) => a -> Map a (NESet b) -> Set b lookupDom_ x xs = maybe Set.empty Set.NonEmpty.toSet (Map.lookup x xs) -- | Look up the @a@ related to a @b@. -- -- /O(log b)/. -lookupRan :: Ord b => b -> BiMultimap a b -> Maybe a +lookupRan :: (Ord b) => b -> BiMultimap a b -> Maybe a lookupRan b (BiMultimap _ r) = Map.lookup b r -- | Look up the @a@ related to a @b@. -- -- /O(log b)/. -unsafeLookupRan :: Ord b => b -> BiMultimap a b -> a +unsafeLookupRan :: (Ord b) => b -> BiMultimap a b -> a unsafeLookupRan b (BiMultimap _ r) = r Map.! b @@ -162,11 +162,11 @@ range = toMapR -- | Construct a left-unique relation from a mapping from its left-elements to set-of-right-elements. The caller is -- responsible for ensuring that no right-element is mapped to by two different left-elements. -unsafeFromDomain :: Ord b => Map a (NESet b) -> BiMultimap a b +unsafeFromDomain :: (Ord b) => Map a (NESet b) -> BiMultimap a b unsafeFromDomain domain = BiMultimap domain (invertDomain domain) -invertDomain :: forall a b. Ord b => Map a (NESet b) -> Map b a +invertDomain :: forall a b. (Ord b) => Map a (NESet b) -> Map b a invertDomain = Map.foldlWithKey' f Map.empty where @@ -216,7 +216,7 @@ insert a b m@(BiMultimap l r) = l' = Map.upsert (maybe (Set.NonEmpty.singleton b) (Set.NonEmpty.insert b)) a l -- @upsertFunc x@ returns a function that upserts @x@, suitable for passing to @Map.alterF@. -upsertFunc :: Eq a => a -> Maybe a -> (UpsertResult a, Maybe a) +upsertFunc :: (Eq a) => a -> Maybe a -> (UpsertResult a, Maybe a) upsertFunc new existing = case existing of Nothing -> (Inserted, Just new) @@ -248,7 +248,7 @@ unsafeUnion xs ys = ------------------------------------------------------------------------------------------------------------------------ -- @deriveRangeFromDomain x ys range@ is a helper that inserts @(x, y1)@, @(x, y2)@, ... into range @r@. -deriveRangeFromDomain :: Ord b => a -> NESet b -> Map b a -> Map b a +deriveRangeFromDomain :: (Ord b) => a -> NESet b -> Map b a -> Map b a deriveRangeFromDomain x ys acc = foldr (flip Map.insert x) acc ys {-# INLINE deriveRangeFromDomain #-} diff --git a/parser-typechecker/src/U/Codebase/Branch/Diff.hs b/parser-typechecker/src/U/Codebase/Branch/Diff.hs index c4a7291547..430155a4cc 100644 --- a/parser-typechecker/src/U/Codebase/Branch/Diff.hs +++ b/parser-typechecker/src/U/Codebase/Branch/Diff.hs @@ -78,7 +78,7 @@ instance (Applicative m) => Semigroup (TreeDiff m) where instance (Applicative m) => Monoid (TreeDiff m) where mempty = TreeDiff (mempty :< Compose mempty) -hoistTreeDiff :: Functor m => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n +hoistTreeDiff :: (Functor m) => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n hoistTreeDiff f (TreeDiff cfr) = TreeDiff $ Cofree.hoistCofree (\(Compose m) -> Compose (fmap f m)) cfr diff --git a/parser-typechecker/src/Unison/Builtin/Decls.hs b/parser-typechecker/src/Unison/Builtin/Decls.hs index 35d70245d7..a918671d8d 100644 --- a/parser-typechecker/src/Unison/Builtin/Decls.hs +++ b/parser-typechecker/src/Unison/Builtin/Decls.hs @@ -174,13 +174,13 @@ rewriteCaseRef = lookupDeclRef "RewriteCase" pattern RewriteCase' :: Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a pattern RewriteCase' lhs rhs <- (unRewriteCase -> Just (lhs, rhs)) -rewriteCase :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a +rewriteCase :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a rewriteCase a tm1 tm2 = Term.app a (Term.app a1 (Term.constructor a1 r) tm1) tm2 where a1 = ABT.annotation tm1 r = ConstructorReference rewriteCaseRef 0 -rewriteTerm :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a +rewriteTerm :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a rewriteTerm a tm1 tm2 = Term.app a (Term.app a1 (Term.constructor a1 r) tm1) tm2 where a1 = ABT.annotation tm1 diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 79b00026a4..a741477b0c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -396,12 +396,9 @@ typeLookupForDependencies codebase s = do unseen :: TL.TypeLookup Symbol a -> Reference -> Bool unseen tl r = isNothing - ( Map.lookup r (TL.dataDecls tl) - $> () - <|> Map.lookup r (TL.typeOfTerms tl) - $> () - <|> Map.lookup r (TL.effectDecls tl) - $> () + ( Map.lookup r (TL.dataDecls tl) $> () + <|> Map.lookup r (TL.typeOfTerms tl) $> () + <|> Map.lookup r (TL.effectDecls tl) $> () ) toCodeLookup :: (MonadIO m) => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index 00e2f76901..5213694e4a 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -318,7 +318,7 @@ cons = step . const -- | Construct a two-parent merge node. mergeNode :: forall m. - Applicative m => + (Applicative m) => Branch0 m -> (CausalHash, m (Branch m)) -> (CausalHash, m (Branch m)) -> diff --git a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs index 192bf8147c..e639fd41b0 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs @@ -25,8 +25,8 @@ import Unison.Codebase.Branch (Branch, Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path -import Unison.NameSegment (NameSegment) import Unison.HashQualifiedPrime (HashQualified (HashQualified, NameOnly)) +import Unison.NameSegment (NameSegment) import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 5244facbf8..9052e5511a 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -115,9 +115,9 @@ checkCodebaseIsUpToDate = do -- The highest schema that this ucm knows how to migrate to. pure $ if - | schemaVersion == Q.currentSchemaVersion -> CodebaseUpToDate - | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion - | otherwise -> CodebaseUnknownSchemaVersion schemaVersion + | schemaVersion == Q.currentSchemaVersion -> CodebaseUpToDate + | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion + | otherwise -> CodebaseUnknownSchemaVersion schemaVersion -- | Migrates a codebase up to the most recent version known to ucm. -- This is a No-op if it's up to date diff --git a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs index 0a218b0c34..59d168b2e1 100644 --- a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs +++ b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs @@ -40,7 +40,7 @@ import Unison.Var qualified as Var -- -- Note that we can't actually tell whether the Decl was originally a record or not, so we -- include all possible accessors, but they may or may not exist in the codebase. -labeledDeclDependenciesIncludingSelfAndFieldAccessors :: Var v => TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency +labeledDeclDependenciesIncludingSelfAndFieldAccessors :: (Var v) => TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency labeledDeclDependenciesIncludingSelfAndFieldAccessors selfRef decl = DD.labeledDeclDependenciesIncludingSelf selfRef decl <> case decl of diff --git a/parser-typechecker/src/Unison/KindInference.hs b/parser-typechecker/src/Unison/KindInference.hs index 8265f042b0..081b758690 100644 --- a/parser-typechecker/src/Unison/KindInference.hs +++ b/parser-typechecker/src/Unison/KindInference.hs @@ -79,7 +79,7 @@ inferDecls ppe declMap = -- | Break the decls into strongly connected components in reverse -- topological order -intoComponents :: forall v a. Ord v => Map Reference (Decl v a) -> [[(Reference, Decl v a)]] +intoComponents :: forall v a. (Ord v) => Map Reference (Decl v a) -> [[(Reference, Decl v a)]] intoComponents declMap = let graphInput :: [(Decl v a, Reference, [Reference])] graphInput = Map.foldrWithKey (\k a b -> (a, k, declReferences a) : b) [] declMap diff --git a/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs b/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs index 5f261aa2cb..27609d13f8 100644 --- a/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs +++ b/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs @@ -43,7 +43,7 @@ prettyArrow prec lhs rhs = in wrap (lhs <> " -> " <> rhs) prettyCyclicSolvedConstraint :: - Var v => + (Var v) => Solved.Constraint (UVar v loc) v loc -> Int -> Map (UVar v loc) (P.Pretty P.ColorText) -> @@ -62,7 +62,7 @@ prettyCyclicSolvedConstraint constraint prec nameMap visitingSet = case constrai pure (prettyArrow prec pa pb, cyclicLhs <> cyclicRhs) prettyCyclicUVarKindWorker :: - Var v => + (Var v) => Int -> UVar v loc -> Map (UVar v loc) (P.Pretty P.ColorText) -> @@ -78,11 +78,11 @@ prettyCyclicUVarKindWorker prec u nameMap visitingSet = -- | Pretty print the kind constraint on the given @UVar@. -- -- __Precondition:__ The @ConstraintMap@ is acyclic. -prettyUVarKind :: Var v => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> P.Pretty P.ColorText +prettyUVarKind :: (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> P.Pretty P.ColorText prettyUVarKind ppe constraints uvar = ppRunner ppe constraints do prettyUVarKind' arrPrec uvar -prettyUVarKind' :: Var v => Int -> UVar v loc -> Solve v loc (P.Pretty P.ColorText) +prettyUVarKind' :: (Var v) => Int -> UVar v loc -> Solve v loc (P.Pretty P.ColorText) prettyUVarKind' prec u = find u >>= \case Nothing -> pure (prettyUnknown prec) @@ -92,7 +92,7 @@ prettyUVarKind' prec u = -- -- __Precondition:__ The @ConstraintMap@ is acyclic. prettySolvedConstraint :: - Var v => + (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> Solved.Constraint (UVar v loc) v loc -> @@ -100,7 +100,7 @@ prettySolvedConstraint :: prettySolvedConstraint ppe constraints c = ppRunner ppe constraints (prettySolvedConstraint' arrPrec c) -prettySolvedConstraint' :: Var v => Int -> Solved.Constraint (UVar v loc) v loc -> Solve v loc (P.Pretty P.ColorText) +prettySolvedConstraint' :: (Var v) => Int -> Solved.Constraint (UVar v loc) v loc -> Solve v loc (P.Pretty P.ColorText) prettySolvedConstraint' prec = \case Solved.IsAbility _ -> pure (prettyAbility prec) Solved.IsType _ -> pure (prettyType prec) @@ -113,7 +113,7 @@ prettySolvedConstraint' prec = \case -- constraint map, but no constraints are added. This runner just -- allows running pretty printers outside of the @Solve@ monad by -- discarding the resulting state. -ppRunner :: Var v => PrettyPrintEnv -> ConstraintMap v loc -> (forall r. Solve v loc r -> r) +ppRunner :: (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> (forall r. Solve v loc r -> r) ppRunner ppe constraints = let st = SolveState @@ -130,7 +130,7 @@ ppRunner ppe constraints = -- -- __Precondition:__ The @UVar@ has a cyclic constraint. prettyCyclicUVarKind :: - Var v => + (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> diff --git a/parser-typechecker/src/Unison/KindInference/Error.hs b/parser-typechecker/src/Unison/KindInference/Error.hs index 2e977e0493..e9d0900a0a 100644 --- a/parser-typechecker/src/Unison/KindInference/Error.hs +++ b/parser-typechecker/src/Unison/KindInference/Error.hs @@ -28,7 +28,7 @@ data ConstraintConflict v loc = ConstraintConflict' conflictedConstraint :: Solved.Constraint (UVar v loc) v loc } -lspLoc :: Semigroup loc => KindError v loc -> loc +lspLoc :: (Semigroup loc) => KindError v loc -> loc lspLoc = \case CycleDetected loc _ _ -> loc UnexpectedArgument _ abs arg _ -> varLoc abs <> varLoc arg @@ -45,30 +45,30 @@ data KindError v loc CycleDetected loc (UVar v loc) (ConstraintMap v loc) | -- | Something of kind * or Effect is applied to an argument UnexpectedArgument + -- | src span of abs loc - -- ^ src span of abs + -- | abs var (UVar v loc) - -- ^ abs var + -- | arg var (UVar v loc) - -- ^ arg var - (ConstraintMap v loc) - -- ^ context + -- | context -- | An arrow kind is applied to a type, but its kind doesn't match -- the expected argument kind + (ConstraintMap v loc) | ArgumentMismatch + -- | abs var (UVar v loc) - -- ^ abs var + -- | expected var (UVar v loc) - -- ^ expected var + -- | given var (UVar v loc) - -- ^ given var - (ConstraintMap v loc) - -- ^ context + -- | context -- | Same as @ArgumentMismatch@, but for applications to the builtin -- @Arrow@ type. + (ConstraintMap v loc) | ArgumentMismatchArrow + -- | (The applied arrow range, lhs, rhs) (loc, Type v loc, Type v loc) - -- ^ (The applied arrow range, lhs, rhs) (ConstraintConflict v loc) (ConstraintMap v loc) | -- | Something appeared in an effect list that isn't of kind Effect @@ -77,22 +77,22 @@ data KindError v loc (ConstraintMap v loc) | -- | Generic constraint conflict ConstraintConflict + -- | Failed to add this constraint (GeneratedConstraint v loc) - -- ^ Failed to add this constraint + -- | Due to this conflict (ConstraintConflict v loc) - -- ^ Due to this conflict + -- | in this context (ConstraintMap v loc) - -- ^ in this context -- | Transform generic constraint conflicts into more specific error -- by examining its @ConstraintContext@. -improveError :: Var v => KindError v loc -> Solve v loc (KindError v loc) +improveError :: (Var v) => KindError v loc -> Solve v loc (KindError v loc) improveError = \case ConstraintConflict a b c -> improveError' a b c e -> pure e improveError' :: - Var v => + (Var v) => GeneratedConstraint v loc -> ConstraintConflict v loc -> ConstraintMap v loc -> diff --git a/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs b/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs index b1db1ac911..cf14da1ad6 100644 --- a/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs +++ b/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs @@ -17,7 +17,7 @@ import Unison.Var (Var) -- | Pretty print a user-facing @KindError@. prettyKindError :: - Var v => + (Var v) => -- | How to print types (Type v loc -> Pretty ColorText) -> -- | How to print source spans diff --git a/parser-typechecker/src/Unison/KindInference/Generate.hs b/parser-typechecker/src/Unison/KindInference/Generate.hs index b235108745..ab675534d2 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate.hs @@ -106,7 +106,7 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do effConstraints <- typeConstraintTree effKind eff pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints -handleIntroOuter :: Var v => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r +handleIntroOuter :: (Var v) => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r handleIntroOuter v loc k = do let typ = Type.var loc v new <- freshVar typ @@ -171,7 +171,7 @@ dfAnns annAlg cons nil = ABT.cata \ann abt0 -> case abt0 of -- Our rewrite signature machinery generates type annotations that are -- not well kinded. Work around this for now by stripping those -- annotations. -hackyStripAnns :: Ord v => Term.Term v loc -> Term.Term v loc +hackyStripAnns :: (Ord v) => Term.Term v loc -> Term.Term v loc hackyStripAnns = snd . ABT.cata \ann abt0 -> case abt0 of ABT.Var v -> (False, ABT.var ann v) diff --git a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs index 7b374d6efa..4271665beb 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs @@ -52,7 +52,7 @@ run :: Gen v loc a -> GenState v loc -> (a, GenState v loc) run (Gen ma) st0 = ma st0 -- | Create a unique @UVar@ associated with @typ@ -freshVar :: Var v => T.Type v loc -> Gen v loc (UVar v loc) +freshVar :: (Var v) => T.Type v loc -> Gen v loc (UVar v loc) freshVar typ = do st@GenState {unifVars, newVars} <- get let var :: Symbol @@ -63,7 +63,7 @@ freshVar typ = do pure uvar -- | Associate a fresh @UVar@ with @t@, push onto context -pushType :: Var v => T.Type v loc -> Gen v loc (UVar v loc) +pushType :: (Var v) => T.Type v loc -> Gen v loc (UVar v loc) pushType t = do GenState {typeMap} <- get (var, newTypeMap) <- @@ -75,13 +75,13 @@ pushType t = do pure var -- | Lookup the @UVar@ associated with a @Type@ -lookupType :: Var v => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) +lookupType :: (Var v) => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) lookupType t = do GenState {typeMap} <- get pure (NonEmpty.head <$> Map.lookup t typeMap) -- | Remove a @Type@ from the context -popType :: Var v => T.Type v loc -> Gen v loc () +popType :: (Var v) => T.Type v loc -> Gen v loc () popType t = do modify \st -> st {typeMap = del (typeMap st)} where @@ -94,7 +94,7 @@ popType t = do in Map.alter f t m -- | Helper to run an action with the given @Type@ in the context -scopedType :: Var v => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r +scopedType :: (Var v) => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r scopedType t m = do s <- pushType t r <- m s diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 1bf58960f5..623152972a 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -89,7 +89,7 @@ step e st cs = Right () -> Right finalState -- | Default any unconstrained vars to @Type@ -defaultUnconstrainedVars :: Var v => SolveState v loc -> SolveState v loc +defaultUnconstrainedVars :: (Var v) => SolveState v loc -> SolveState v loc defaultUnconstrainedVars st = let newConstraints = foldl' phi (constraints st) (newUnifVars st) phi b a = U.alter a handleNothing handleJust b @@ -167,8 +167,7 @@ reduce cs0 = dbg "reduce" cs0 (go False []) -- contradictory constraint. addConstraint :: forall v loc. - Ord loc => - Var v => + (Ord loc, Var v) => GeneratedConstraint v loc -> Solve v loc (Either (KindError v loc) ()) addConstraint constraint = do @@ -200,8 +199,7 @@ addConstraint constraint = do -- satisfied. addConstraint' :: forall v loc. - Ord loc => - Var v => + (Ord loc, Var v) => UnsolvedConstraint v loc -> Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) addConstraint' = \case @@ -304,7 +302,7 @@ union _unionLoc a b = do -- | Do an occurence check and return an error or the resulting solve -- state verify :: - Var v => + (Var v) => SolveState v loc -> Either (NonEmpty (KindError v loc)) (SolveState v loc) verify st = @@ -347,7 +345,7 @@ assertGen gen = do -- | occurence check and report any errors occCheck :: forall v loc. - Var v => + (Var v) => ConstraintMap v loc -> Either (NonEmpty (KindError v loc)) (ConstraintMap v loc) occCheck constraints0 = @@ -401,7 +399,7 @@ data OccCheckState v loc = OccCheckState kindErrors :: [KindError v loc] } -markVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) CycleCheck +markVisiting :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) CycleCheck markVisiting x = do OccCheckState {visitingSet, visitingStack} <- M.get case Set.member x visitingSet of @@ -420,7 +418,7 @@ markVisiting x = do } pure NoCycle -unmarkVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) () +unmarkVisiting :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) () unmarkVisiting x = M.modify \st -> st { visitingSet = Set.delete x (visitingSet st), @@ -431,7 +429,7 @@ unmarkVisiting x = M.modify \st -> addError :: KindError v loc -> M.State (OccCheckState v loc) () addError ke = M.modify \st -> st {kindErrors = ke : kindErrors st} -isSolved :: Var v => UVar v loc -> M.State (OccCheckState v loc) Bool +isSolved :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) Bool isSolved x = do OccCheckState {solvedSet} <- M.get pure $ Set.member x solvedSet @@ -444,7 +442,7 @@ data CycleCheck -- Debug output helpers -------------------------------------------------------------------------------- -prettyConstraintD' :: Show loc => Var v => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText +prettyConstraintD' :: (Show loc, Var v) => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText prettyConstraintD' ppe = P.wrap . \case Unsolved.IsType v p -> prettyUVar ppe v <> " ~ Type" <> prettyProv p @@ -455,10 +453,10 @@ prettyConstraintD' ppe = prettyProv x = "[" <> P.string (show x) <> "]" -prettyConstraints :: Show loc => Var v => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText +prettyConstraints :: (Show loc, Var v) => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText prettyConstraints ppe = P.sep "\n" . map (prettyConstraintD' ppe) -prettyUVar :: Var v => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText +prettyUVar :: (Var v) => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText prettyUVar ppe (UVar s t) = TP.pretty ppe t <> " :: " <> P.prettyVar s tracePretty :: P.Pretty P.ColorText -> a -> a diff --git a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs index 82090bf237..21cd38b95e 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs @@ -88,7 +88,7 @@ genStateL f st = } -- | Interleave constraint generation into constraint solving -runGen :: Var v => Gen v loc a -> Solve v loc a +runGen :: (Var v) => Gen v loc a -> Solve v loc a runGen gena = do st <- M.get let gena' = do @@ -104,7 +104,7 @@ runGen gena = do -- | Add a unification variable to the constarint mapping with no -- constraints. This is done on uvars created during constraint -- generation to initialize the new uvars (see 'runGen'). -addUnconstrainedVar :: Var v => UVar v loc -> Solve v loc () +addUnconstrainedVar :: (Var v) => UVar v loc -> Solve v loc () addUnconstrainedVar uvar = do st@SolveState {constraints} <- M.get let constraints' = U.insert uvar Descriptor {descriptorConstraint = Nothing} constraints @@ -125,7 +125,7 @@ emptyState = } -- | Lookup the constraints associated with a unification variable -find :: Var v => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) +find :: (Var v) => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) find k = do st@SolveState {constraints} <- M.get case U.lookupCanon k constraints of diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index 0e985764d9..fc1500a12f 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -81,5 +81,5 @@ unsafeParseFileBuiltinsOnly = names = Builtin.names } -unsafeParseFile :: Monad m => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) +unsafeParseFile :: (Monad m) => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) unsafeParseFile s pEnv = unsafeGetRightFrom s <$> parseFile "" s pEnv diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs index 06088b8618..10e7ed42a1 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs @@ -39,20 +39,20 @@ data Constraint vt v loc NegLit v PmLit | -- | Positive constraint on list element with position relative to head of list PosListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable | -- | Positive constraint on list element with position relative to end of list PosListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable | -- | Negative constraint on length of the list (/i.e./ the list -- may not be an element of the interval set) NegListInterval v IntervalSet diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs index 38feb90cc5..7a353817a6 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs @@ -43,21 +43,21 @@ data Literal vt v loc NegLit v PmLit | -- | Positive constraint on list element with position relative to head of list PosListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable (Type vt loc) | -- | Positive constraint on list element with position relative to end of list PosListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable (Type vt loc) | -- | Negative constraint on length of the list (/i.e./ the list -- may not be an element of the interval set) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs index 4cb60551bd..832a8bb5fe 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs @@ -216,14 +216,14 @@ data VarConstraints vt v loc | Vc'Text (Maybe Text) (Set Text) | Vc'Char (Maybe Char) (Set Char) | Vc'ListRoot + -- | type of list elems (Type vt loc) - -- ^ type of list elems + -- | Positive constraint on cons elements (Seq v) - -- ^ Positive constraint on cons elements + -- | Positive constraint on snoc elements (Seq v) - -- ^ Positive constraint on snoc elements + -- | positive constraint on input list size IntervalSet - -- ^ positive constraint on input list size deriving stock (Show, Eq, Ord, Generic) data EffectInfo diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs index 9a7721cf58..41bf27573a 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs @@ -17,39 +17,39 @@ data loc -- annotation = -- | @PmCon x Con xs ys@ corresponds to the constraint @Con ys <- x@ PmCon + -- | Variable v - -- ^ Variable + -- | Constructor ConstructorReference - -- ^ Constructor + -- | Constructor argument values and types [(v, Type vt loc)] - -- ^ Constructor argument values and types | PmEffect + -- | Variable v - -- ^ Variable + -- | Constructor ConstructorReference - -- ^ Constructor + -- | Constructor argument values and types [(v, Type vt loc)] - -- ^ Constructor argument values and types | PmEffectPure v (v, Type vt loc) | PmLit v PmLit | PmListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable + -- | element type (Type vt loc) - -- ^ element type | PmListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable + -- | element type (Type vt loc) - -- ^ element type | -- | The size of the list must fall within this inclusive range PmListInterval v Int Int | -- | If a guard performs an effect diff --git a/parser-typechecker/src/Unison/Result.hs b/parser-typechecker/src/Unison/Result.hs index 2c1a75662e..63df0a99e0 100644 --- a/parser-typechecker/src/Unison/Result.hs +++ b/parser-typechecker/src/Unison/Result.hs @@ -39,7 +39,7 @@ pattern Result notes may = MaybeT (WriterT (Identity (may, notes))) {-# COMPLETE Result #-} -makeResult :: Applicative m => notes -> Maybe a -> ResultT notes m a +makeResult :: (Applicative m) => notes -> Maybe a -> ResultT notes m a makeResult notes value = MaybeT (WriterT (pure (value, notes))) diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs index f5967cf3f2..0c2fa20ff8 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF.hs @@ -1909,15 +1909,16 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) [] <- vs = AccumText Nothing . Map.singleton (Util.Text.fromText t) <$> anfBody bd | P.Constructor _ (ConstructorReference r t) ps <- p = do - (,) <$> expandBindings ps vs <*> anfBody bd <&> \(us, bd) -> - AccumData r Nothing - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - $ bd + (,) + <$> expandBindings ps vs + <*> anfBody bd + <&> \(us, bd) -> + AccumData r Nothing . EC.mapSingleton (fromIntegral t) . (BX <$ us,) $ ABTN.TAbss us bd | P.EffectPure _ q <- p = - (,) <$> expandBindings [q] vs <*> anfBody bd <&> \(us, bd) -> - AccumPure $ ABTN.TAbss us bd + (,) + <$> expandBindings [q] vs + <*> anfBody bd + <&> \(us, bd) -> AccumPure $ ABTN.TAbss us bd | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do (,,) <$> expandBindings (snoc ps pk) vs @@ -1934,8 +1935,7 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) . (BX <$ us,) . ABTN.TAbss us . TShift r kf - . TName uk (Left jn) [kf] - $ bd + $ TName uk (Left jn) [kf] bd | P.SequenceLiteral _ [] <- p = AccumSeqEmpty <$> anfBody bd | P.SequenceOp _ l op r <- p, @@ -1985,7 +1985,7 @@ blitLinks :: (Monoid a) => (Bool -> Reference -> a) -> BLit -> a blitLinks f (List s) = foldMap (valueLinks f) s blitLinks _ _ = mempty -groupTermLinks :: Var v => SuperGroup v -> [Reference] +groupTermLinks :: (Var v) => SuperGroup v -> [Reference] groupTermLinks = Set.toList . foldGroupLinks f where f False r = Set.singleton r diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs b/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs index 3a501744ff..4bd3c2434f 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs @@ -19,7 +19,7 @@ import Unison.Runtime.ANF.Serialize as ANF import Unison.Var (Var) checkGroupHashes :: - Var v => + (Var v) => [(Referent, SuperGroup v)] -> Either (Text, [Referent]) (Either [Referent] [Referent]) checkGroupHashes rgs = case checkMissing rgs of @@ -32,7 +32,7 @@ checkGroupHashes rgs = case checkMissing rgs of Right ms -> Right (Left $ Ref <$> ms) rehashGroups :: - Var v => + (Var v) => Map.Map Reference (SuperGroup v) -> Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) rehashGroups m @@ -56,7 +56,7 @@ rehashGroups m (rm, sgs) = rehashSCC scc checkMissing :: - Var v => + (Var v) => [(Referent, SuperGroup v)] -> Either (Text, [Referent]) [Reference] checkMissing (unzip -> (rs, gs)) = do @@ -74,7 +74,7 @@ checkMissing (unzip -> (rs, gs)) = do p _ _ = False rehashSCC :: - Var v => + (Var v) => SCC (Reference, SuperGroup v) -> (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) rehashSCC scc diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs index 6bb4b315f2..995856e1b4 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs @@ -19,8 +19,8 @@ import Data.Sequence qualified as Seq import Data.Serialize.Put (runPutLazy) import Data.Text (Text) import Data.Word (Word16, Word32, Word64) -import GHC.Stack import GHC.IsList qualified (fromList) +import GHC.Stack import Unison.ABT.Normalized (Term (..)) import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) import Unison.Runtime.ANF as ANF hiding (Tag) @@ -948,7 +948,7 @@ serializeGroup fops sg = runPutS (putVersion *> putGroup mempty fops sg) -- Supplying a `Builtin` reference is not supported. Such code -- shouldn't be subject to rehashing. serializeGroupForRehash :: - Var v => + (Var v) => EC.EnumMap FOp Text -> Reference -> SuperGroup v -> @@ -962,7 +962,7 @@ serializeGroupForRehash fops (Derived h _) sg = f _ = Nothing refrep = Map.fromList . mapMaybe f $ groupTermLinks sg -getVersionedValue :: MonadGet m => m Value +getVersionedValue :: (MonadGet m) => m Value getVersionedValue = getVersion >>= getValue where getVersion = diff --git a/parser-typechecker/src/Unison/Runtime/Array.hs b/parser-typechecker/src/Unison/Runtime/Array.hs index a067d93383..1b6d34fdc2 100644 --- a/parser-typechecker/src/Unison/Runtime/Array.hs +++ b/parser-typechecker/src/Unison/Runtime/Array.hs @@ -56,7 +56,7 @@ import Data.Primitive.PrimArray as EPA hiding import Data.Primitive.PrimArray qualified as PA import Data.Primitive.Types import Data.Word (Word8) -import GHC.IsList (toList ) +import GHC.IsList (toList) #ifdef ARRAY_CHECK import GHC.Stack diff --git a/parser-typechecker/src/Unison/Runtime/Exception.hs b/parser-typechecker/src/Unison/Runtime/Exception.hs index dff4a627b7..16a149d953 100644 --- a/parser-typechecker/src/Unison/Runtime/Exception.hs +++ b/parser-typechecker/src/Unison/Runtime/Exception.hs @@ -18,7 +18,7 @@ instance Exception RuntimeExn die :: (HasCallStack) => String -> IO a die = throwIO . PE callStack . P.lit . fromString -dieP :: HasCallStack => P.Pretty P.ColorText -> IO a +dieP :: (HasCallStack) => P.Pretty P.ColorText -> IO a dieP = throwIO . PE callStack exn :: (HasCallStack) => String -> a diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/parser-typechecker/src/Unison/Runtime/Interface.hs index 3ef03e6b5e..66139742bb 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/parser-typechecker/src/Unison/Runtime/Interface.hs @@ -505,7 +505,7 @@ interpEval activeThreads cleanupThreads ctxVar cl ppe tm = evalInContext ppe ctx activeThreads initw `UnliftIO.finally` cleanupThreads -ensureExists :: HasCallStack => CreateProcess -> (CmdSpec -> Either (Int, String, String) IOException -> Pretty ColorText) -> IO () +ensureExists :: (HasCallStack) => CreateProcess -> (CmdSpec -> Either (Int, String, String) IOException -> Pretty ColorText) -> IO () ensureExists cmd err = ccall >>= \case Nothing -> pure () @@ -517,13 +517,13 @@ ensureExists cmd err = (ExitFailure exitCode, stdout, stderr) -> pure (Just (Left (exitCode, stdout, stderr))) ccall = call `UnliftIO.catch` \(e :: IOException) -> pure . Just $ Right e -ensureRuntimeExists :: HasCallStack => FilePath -> IO () +ensureRuntimeExists :: (HasCallStack) => FilePath -> IO () ensureRuntimeExists executable = ensureExists cmd runtimeErrMsg where cmd = proc executable ["--help"] -ensureRacoExists :: HasCallStack => IO () +ensureRacoExists :: (HasCallStack) => IO () ensureRacoExists = ensureExists (shell "raco help") racoErrMsg prettyCmdSpec :: CmdSpec -> Pretty ColorText diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs index 1d1213cc45..064200cd55 100644 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs @@ -117,11 +117,7 @@ getLength = unVarInt <$> deserialize -- Checks for negatives, in case you put an Integer, which does not -- behave properly for negative numbers. putPositive :: - MonadPut m => - Bits n => - Bits (Unsigned n) => - Integral n => - Integral (Unsigned n) => + (MonadPut m, Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) => n -> m () putPositive n @@ -130,12 +126,7 @@ putPositive n -- Reads as an Integer, then checks that the result will fit in the -- result type. -getPositive :: - forall m n. - Bounded n => - Integral n => - MonadGet m => - m n +getPositive :: forall m n. (Bounded n, Integral n, MonadGet m) => m n getPositive = validate . unVarInt =<< deserialize where mx0 :: n diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 9d2c7f23f3..6185747380 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -125,7 +125,7 @@ file = do -- | Final validations and sanity checks to perform before finishing parsing. validateUnisonFile :: - Ord v => + (Ord v) => Map v (TypeReferenceId, DataDeclaration v Ann) -> Map v (TypeReferenceId, EffectDeclaration v Ann) -> [(v, Ann, Term v Ann)] -> @@ -139,7 +139,7 @@ validateUnisonFile datas effects terms watches = -- constructors and verify that no duplicates exist in the file, triggering an error if needed. checkForDuplicateTermsAndConstructors :: forall m v. - Ord v => + (Ord v) => Map v (TypeReferenceId, DataDeclaration v Ann) -> Map v (TypeReferenceId, EffectDeclaration v Ann) -> [(v, Ann, Term v Ann)] -> diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 9e5b23f701..635a974d89 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -1011,12 +1011,9 @@ force = P.label "force" $ P.try do seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = - Pattern.Snoc - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) - <|> Pattern.Cons - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) - <|> Pattern.Concat - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) + Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) + <|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) + <|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) term4 :: (Monad m, Var v) => TermP v m term4 = f <$> some termLeaf diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 3ec03464fd..faeda76020 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -969,7 +969,7 @@ prettyBinding0' a@AmbientContext {imports = im, docContext = doc} v term = PP.group $ PP.group (defnLhs v vs <> fmt S.BindingEquals " = ") <> prettyBody - `PP.orElse` ("\n" <> PP.indentN 2 prettyBody) + `PP.orElse` ("\n" <> PP.indentN 2 prettyBody) } _ -> pure $ @@ -1532,7 +1532,7 @@ immediateChildBlockTerms = \case doLet (v, LamsNamedOpt' _ body) = [body | not (Var.isAction v), isLet body] doLet t = error (show t) [] -isSoftHangable :: Var v => Term2 vt at ap v a -> Bool +isSoftHangable :: (Var v) => Term2 vt at ap v a -> Bool -- isSoftHangable (Delay' d) = isLet d || isSoftHangable d || case d of -- Match' scrute cases -> isDestructuringBind scrute cases -- _ -> False @@ -2160,7 +2160,7 @@ avoidShadowing tm (PrettyPrintEnv terms types) = & maybe fullName HQ'.NameOnly in (fullName, minimallySuffixed) tweak _ p = p - varToName :: Var v => v -> [Name] + varToName :: (Var v) => v -> [Name] varToName = toList . Name.parseText . Var.name isLeaf :: Term2 vt at ap v a -> Bool diff --git a/parser-typechecker/src/Unison/Syntax/TypeParser.hs b/parser-typechecker/src/Unison/Syntax/TypeParser.hs index 7a143c7877..e270ef25eb 100644 --- a/parser-typechecker/src/Unison/Syntax/TypeParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TypeParser.hs @@ -101,7 +101,7 @@ sequenceTyp = do let a = ann open <> ann close pure $ Type.app a (Type.list a) t -tupleOrParenthesizedType :: Var v => TypeP v m -> TypeP v m +tupleOrParenthesizedType :: (Var v) => TypeP v m -> TypeP v m tupleOrParenthesizedType rec = do (spanAnn, ty) <- tupleOrParenthesized rec DD.unitType pair pure (ty {ABT.annotation = ABT.annotation ty <> spanAnn}) diff --git a/parser-typechecker/src/Unison/Typechecker.hs b/parser-typechecker/src/Unison/Typechecker.hs index d20c7bec0c..b40b5a5626 100644 --- a/parser-typechecker/src/Unison/Typechecker.hs +++ b/parser-typechecker/src/Unison/Typechecker.hs @@ -249,7 +249,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do guard x a = if x then Just a else Nothing - suggestedVar :: Var v => v -> Text -> v + suggestedVar :: (Var v) => v -> Text -> v suggestedVar v name = case Var.typeOf v of Var.MissingResult -> v diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 075622ecee..89eb193212 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -606,15 +606,15 @@ debugTrace :: String -> Bool debugTrace e | debugEnabled = trace e False debugTrace _ = False -showType :: Var v => Type.Type v a -> String +showType :: (Var v) => Type.Type v a -> String showType ty = TP.prettyStr (Just 120) PPE.empty ty -debugType :: Var v => String -> Type.Type v a -> Bool +debugType :: (Var v) => String -> Type.Type v a -> Bool debugType tag ty | debugEnabled = debugTrace $ "(" <> show tag <> "," <> showType ty <> ")" | otherwise = False -debugTypes :: Var v => String -> Type.Type v a -> Type.Type v a -> Bool +debugTypes :: (Var v) => String -> Type.Type v a -> Type.Type v a -> Bool debugTypes tag t1 t2 | debugEnabled = debugTrace $ "(" <> show tag <> ",\n " <> showType t1 <> ",\n " <> showType t2 <> ")" | otherwise = False diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 9613ce1642..8de9b15224 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -78,7 +78,7 @@ emptyUnisonFile = watches = Map.empty } -leftBiasedMerge :: forall v a. Ord v => UnisonFile v a -> UnisonFile v a -> UnisonFile v a +leftBiasedMerge :: forall v a. (Ord v) => UnisonFile v a -> UnisonFile v a -> UnisonFile v a leftBiasedMerge lhs rhs = let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) (terms lhs) (terms rhs) mergedWatches = Map.foldlWithKey' addWatch (watches lhs) (watches rhs) @@ -340,7 +340,7 @@ dependencies (UnisonFile ds es ts ws) = <> foldMap (Term.dependencies . snd) ts <> foldMap (foldMap (Term.dependencies . view _3)) ws -discardTypes :: Ord v => TypecheckedUnisonFile v a -> UnisonFile v a +discardTypes :: (Ord v) => TypecheckedUnisonFile v a -> UnisonFile v a discardTypes (TypecheckedUnisonFileId datas effects terms watches _) = let watches' = g . mconcat <$> List.multimap watches g tup3s = [(v, a, e) | (v, a, e, _t) <- tup3s] diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 87f9fb6d12..00fdd5f115 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -28,7 +28,7 @@ import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK -toNames :: Var v => UnisonFile v a -> Names +toNames :: (Var v) => UnisonFile v a -> Names toNames uf = datas <> effects where datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf)) @@ -106,7 +106,7 @@ bindNames names (UnisonFileId d e ts ws) = do -- -- It's used below in `environmentFor` and also during the term resolution -- process. -variableCanonicalizer :: forall v. Var v => [v] -> Map v v +variableCanonicalizer :: forall v. (Var v) => [v] -> Map v v variableCanonicalizer vs = done $ List.multimap do v <- vs diff --git a/parser-typechecker/src/Unison/Util/Text.hs b/parser-typechecker/src/Unison/Util/Text.hs index 16947d41f7..c588e35743 100644 --- a/parser-typechecker/src/Unison/Util/Text.hs +++ b/parser-typechecker/src/Unison/Util/Text.hs @@ -140,8 +140,8 @@ indexOf needle haystack = ordinal :: (IsString s) => Int -> s ordinal n = do let s = show n - fromString $ s ++ - case L.drop (L.length s - 2) s of + fromString $ + s ++ case L.drop (L.length s - 2) s of ['1', '1'] -> "th" ['1', '2'] -> "th" ['1', '3'] -> "th" diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs index 083e042868..245ca3424e 100644 --- a/parser-typechecker/tests/Unison/Test/Util/Text.hs +++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs @@ -46,10 +46,8 @@ test = scope "<>" . expect' $ Text.toText (t1s <> t2s <> t3s) == t1 <> t2 <> t3 scope "Ord" . expect' $ - (t1 <> t2 <> t3) - `compare` t3 - == (t1s <> t2s <> t3s) - `compare` t3s + (t1 <> t2 <> t3) `compare` t3 + == (t1s <> t2s <> t3s) `compare` t3s scope "take" . expect' $ Text.toText (Text.take k (t1s <> t2s)) == T.take k (t1 <> t2) scope "drop" . expect' $ diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index bb8ca79047..343ebfeeb5 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -34,7 +34,7 @@ import Unison.Sync.Types qualified as Share -- | Download a project/branch from Share. downloadProjectBranchFromShare :: - HasCallStack => + (HasCallStack) => Share.IncludeSquashedHead -> Share.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) diff --git a/unison-cli/src/Unison/Cli/ServantClientUtils.hs b/unison-cli/src/Unison/Cli/ServantClientUtils.hs index af6723fec1..8b22b26f3d 100644 --- a/unison-cli/src/Unison/Cli/ServantClientUtils.hs +++ b/unison-cli/src/Unison/Cli/ServantClientUtils.hs @@ -25,11 +25,11 @@ classifyConnectionError exception0 = HttpClient.ConnectionFailure exception1 -> do ioException <- fromException @IOException exception1 if - | -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw - -- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this - -- exception, we'd have to parse the `show` output, which is preposterous. - isDoesNotExistError ioException -> - Just ConnectionError'Offline - | otherwise -> Nothing + | -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw + -- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this + -- exception, we'd have to parse the `show` output, which is preposterous. + isDoesNotExistError ioException -> + Just ConnectionError'Offline + | otherwise -> Nothing _ -> Nothing _ -> ConnectionError'SomethingEntirelyUnexpected exception0 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs index 8f2a24e305..2e4144c06d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs @@ -5,6 +5,8 @@ module Unison.Codebase.Editor.HandleInput.DebugSynhashTerm where import Control.Monad.Reader (ask) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text import U.Util.Base32Hex qualified as Base32Hex import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -22,11 +24,9 @@ import Unison.Names qualified as Names import Unison.Prelude import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.Reference qualified as Reference +import Unison.Syntax.Name qualified as Name import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified Unison.Syntax.Name as Name handleDebugSynhashTerm :: Name -> Cli () handleDebugSynhashTerm name = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs index fde32e2235..e0f2cf4294 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs @@ -39,7 +39,7 @@ import Unison.Var qualified as Var -- | Format a file, returning a list of Text replacements to apply to the file. formatFile :: - Monad m => + (Monad m) => (Maybe (UnisonFile Symbol Ann.Ann) -> Maybe (TypecheckedUnisonFile Symbol Ann.Ann) -> m PPED.PrettyPrintEnvDecl) -> Int -> Path.Absolute -> @@ -197,7 +197,7 @@ annToInterval ann = annToRange ann <&> rangeToInterval -- | Returns 'True' if the given symbol is a term with a user provided type signature in the -- parsed file, false otherwise. -hasUserTypeSignature :: Eq v => UnisonFile v a -> v -> Bool +hasUserTypeSignature :: (Eq v) => UnisonFile v a -> v -> Bool hasUserTypeSignature parsedFile sym = Map.toList (UF.terms parsedFile) & any (\(v, (_, trm)) -> v == sym && isJust (Term.getTypeAnnotation trm)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 176a781bfa..eca5b5158a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -489,7 +489,7 @@ loadLibdeps branches = do ------------------------------------------------------------------------------------------------------------------------ -- Merge precondition violation checks -hasDefnsInLib :: Applicative m => V2.Branch m -> m Bool +hasDefnsInLib :: (Applicative m) => V2.Branch m -> m Bool hasDefnsInLib branch = do libdeps <- case Map.lookup NameSegment.libSegment branch.children of diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index 172ceea300..409f7bac89 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -82,12 +82,12 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = q = \case Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) -> if - | ref == DD.testResultRef -> - if - | cid == DD.okConstructorId -> Just (Right msg) - | cid == DD.failConstructorId -> Just (Left msg) - | otherwise -> Nothing - | otherwise -> Nothing + | ref == DD.testResultRef -> + if + | cid == DD.okConstructorId -> Just (Right msg) + | cid == DD.failConstructorId -> Just (Left msg) + | otherwise -> Nothing + | otherwise -> Nothing _ -> Nothing let stats = Output.CachedTests (Set.size testRefs) (Map.size cachedTests) names <- Cli.currentNames @@ -225,9 +225,9 @@ partitionTestResults tm = fold $ do Term.App' (Term.Constructor' (ConstructorReference conRef cid)) (Term.Text' msg) -> do guard (conRef == DD.testResultRef) if - | cid == DD.okConstructorId -> pure (mempty, [msg]) - | cid == DD.failConstructorId -> pure ([msg], mempty) - | otherwise -> empty + | cid == DD.okConstructorId -> pure (mempty, [msg]) + | cid == DD.failConstructorId -> pure ([msg], mempty) + | otherwise -> empty _ -> empty isTestOk :: Term v Ann -> Bool diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 959bc451ef..427c549507 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -127,8 +127,8 @@ data Input | PushRemoteBranchI PushRemoteBranchInput | ResetRootI BranchId | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) - -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - | -- Does it make sense to fork from not-the-root of a Github repo? + | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + -- Does it make sense to fork from not-the-root of a Github repo? -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index c4358247e5..6ae0b23616 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -199,15 +199,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -244,12 +244,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -392,8 +392,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) diff --git a/unison-cli/src/Unison/LSP/Configuration.hs b/unison-cli/src/Unison/LSP/Configuration.hs index e47bff3d76..a95badc33a 100644 --- a/unison-cli/src/Unison/LSP/Configuration.hs +++ b/unison-cli/src/Unison/LSP/Configuration.hs @@ -9,7 +9,7 @@ import Unison.LSP.Types import Unison.Prelude -- | Handle configuration changes. -updateConfig :: Applicative m => Config -> m () +updateConfig :: (Applicative m) => Config -> m () updateConfig _newConfig = pure () parseConfig :: Config -> Value -> Either Text Config diff --git a/unison-cli/src/Unison/LSP/Queries.hs b/unison-cli/src/Unison/LSP/Queries.hs index d8391b8bf7..9613781937 100644 --- a/unison-cli/src/Unison/LSP/Queries.hs +++ b/unison-cli/src/Unison/LSP/Queries.hs @@ -258,7 +258,6 @@ findSmallestEnclosingNode pos term _ -> Nothing ann = getTermSpanAnn term - -- | Most nodes have the property that their annotation spans all their children, but there are some exceptions. getTermSpanAnn :: Term Symbol Ann -> Ann getTermSpanAnn tm = case ABT.out tm of diff --git a/unison-core/src/Unison/Name/Internal.hs b/unison-core/src/Unison/Name/Internal.hs index 3272d43df1..4e00652456 100644 --- a/unison-core/src/Unison/Name/Internal.hs +++ b/unison-core/src/Unison/Name/Internal.hs @@ -33,10 +33,10 @@ import Unison.Util.Alphabetical -- - ".." --> Name Absolute (".." :| []) data Name = Name + -- | whether the name is positioned absolutely (to some arbitrary root namespace), or relatively Position - -- ^ whether the name is positioned absolutely (to some arbitrary root namespace), or relatively + -- | the name segments in reverse order (List.NonEmpty NameSegment) - -- ^ the name segments in reverse order deriving stock (Eq, Generic, Show) -- | Compare names (kinda) alphabetically: absolute comes before relative, but otherwise compare the name segments @@ -49,10 +49,11 @@ instance Alphabetical Name where _ -> compareAlphabetical (segments n1) (segments n2) instance - TypeError - ( 'TypeError.Text - "You cannot make a Name from a string literal because there may (some day) be more than one syntax" - ) => + ( TypeError + ( 'TypeError.Text + "You cannot make a Name from a string literal because there may (some day) be more than one syntax" + ) + ) => IsString Name where fromString = undefined diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index 7080122c04..9b8c2af8ee 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -542,7 +542,7 @@ lenientToNametree names = (lenientRelationToNametree names.terms) (lenientRelationToNametree names.types) where - lenientRelationToNametree :: Ord a => Relation Name a -> Nametree (Map NameSegment a) + lenientRelationToNametree :: (Ord a) => Relation Name a -> Nametree (Map NameSegment a) lenientRelationToNametree = unflattenNametree . lenientRelationToLeftUniqueRelation diff --git a/unison-core/src/Unison/Util/Defns.hs b/unison-core/src/Unison/Util/Defns.hs index 34e17de7e7..e61c5ba7bb 100644 --- a/unison-core/src/Unison/Util/Defns.hs +++ b/unison-core/src/Unison/Util/Defns.hs @@ -56,7 +56,7 @@ type DefnsF3 f g h terms types = type DefnsF4 f g h i terms types = Defns (f (g (h (i terms)))) (f (g (h (i types)))) -alignDefnsWith :: Semialign f => (These a b -> c) -> Defns (f a) (f b) -> f c +alignDefnsWith :: (Semialign f) => (These a b -> c) -> Defns (f a) (f b) -> f c alignDefnsWith f defns = alignWith f defns.terms defns.types diff --git a/unison-core/src/Unison/Util/Nametree.hs b/unison-core/src/Unison/Util/Nametree.hs index 18a6ba3769..a1f52e3316 100644 --- a/unison-core/src/Unison/Util/Nametree.hs +++ b/unison-core/src/Unison/Util/Nametree.hs @@ -49,7 +49,7 @@ instance Unzip Nametree where (ys, zs) = unzipWith (unzipWith f) xs -- | Traverse over a nametree, with access to the list of name segments (in reverse order) leading to each value. -traverseNametreeWithName :: Applicative f => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) +traverseNametreeWithName :: (Applicative f) => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) traverseNametreeWithName f = go [] where @@ -81,7 +81,7 @@ unfoldNametree f x = -- > } flattenNametree :: forall a b. - Ord b => + (Ord b) => (a -> Map NameSegment b) -> Nametree a -> BiMultimap b Name @@ -120,7 +120,7 @@ flattenNametree f = -- > "baz" = #baz -- > } -- > } -unflattenNametree :: Ord a => BiMultimap a Name -> Nametree (Map NameSegment a) +unflattenNametree :: (Ord a) => BiMultimap a Name -> Nametree (Map NameSegment a) unflattenNametree = unfoldNametree unflattenLevel . map (first Name.segments) . Map.toList . BiMultimap.range where diff --git a/unison-core/src/Unison/Var.hs b/unison-core/src/Unison/Var.hs index a78b6638e2..981378624a 100644 --- a/unison-core/src/Unison/Var.hs +++ b/unison-core/src/Unison/Var.hs @@ -58,7 +58,7 @@ named n = typed (User n) -- This bakes the fresh id into the name portion of the variable -- and resets the id to 0. -bakeId :: Var v => v -> v +bakeId :: (Var v) => v -> v bakeId v = named (name v) rawName :: Type -> Text diff --git a/unison-merge/src/Unison/Merge/CombineDiffs.hs b/unison-merge/src/Unison/Merge/CombineDiffs.hs index c983eba79f..973a6911a8 100644 --- a/unison-merge/src/Unison/Merge/CombineDiffs.hs +++ b/unison-merge/src/Unison/Merge/CombineDiffs.hs @@ -44,7 +44,7 @@ combine :: These (DiffOp (Synhashed a)) (DiffOp (Synhashed a)) -> CombinedDiffOp combine = TwoDiffOps.make >>> combine1 >>> fmap (view #value) -combine1 :: Eq a => TwoDiffOps a -> CombinedDiffOp a +combine1 :: (Eq a) => TwoDiffOps a -> CombinedDiffOp a combine1 = \case TwoDiffOps'Add x -> CombinedDiffOp'Add (xor2ior x) TwoDiffOps'Delete x -> CombinedDiffOp'Delete (xor2ior x) diff --git a/unison-merge/src/Unison/Merge/Database.hs b/unison-merge/src/Unison/Merge/Database.hs index 28cc05c937..47d40954e6 100644 --- a/unison-merge/src/Unison/Merge/Database.hs +++ b/unison-merge/src/Unison/Merge/Database.hs @@ -47,7 +47,7 @@ data MergeDatabase = MergeDatabase loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)] } -makeMergeDatabase :: MonadIO m => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase +makeMergeDatabase :: (MonadIO m) => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase makeMergeDatabase codebase = liftIO do -- Create a bunch of cached database lookup functions loadCausal <- do diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 302e46a298..34e3139f4d 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -134,7 +134,7 @@ data IncoherentDeclReason checkDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReason DeclNameLookup) @@ -162,7 +162,7 @@ data IncoherentDeclReasons = IncoherentDeclReasons -- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first. checkAllDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReasons DeclNameLookup) @@ -207,7 +207,7 @@ data OnIncoherentDeclReasons m = OnIncoherentDeclReasons checkDeclCoherencyWith :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> @@ -232,7 +232,7 @@ checkDeclCoherencyWith loadDeclNumConstructors callbacks = checkDeclCoherencyWith_DoTerms :: forall m. - Monad m => + (Monad m) => OnIncoherentDeclReasons m -> [NameSegment] -> (NameSegment, Referent) -> @@ -262,7 +262,7 @@ checkDeclCoherencyWith_DoTerms callbacks prefix = \case checkDeclCoherencyWith_DoTypes :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> ( [NameSegment] -> @@ -331,7 +331,7 @@ checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix child -- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m PartialDeclNameLookup @@ -432,7 +432,7 @@ emptyConstructorNames :: Int -> ConstructorNames emptyConstructorNames numConstructors = IntMap.fromAscList [(i, Nothing) | i <- [0 .. numConstructors - 1]] -recordConstructorName :: HasCallStack => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames +recordConstructorName :: (HasCallStack) => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames recordConstructorName conId conName = IntMap.alterF f (fromIntegral @Word64 @Int conId) where diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-merge/src/Unison/Merge/DeclNameLookup.hs index 08611a944c..35e5b5e10f 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-merge/src/Unison/Merge/DeclNameLookup.hs @@ -40,13 +40,13 @@ data DeclNameLookup = DeclNameLookup deriving stock (Generic) deriving (Semigroup) via (GenericSemigroupMonoid DeclNameLookup) -expectDeclName :: HasCallStack => DeclNameLookup -> Name -> Name +expectDeclName :: (HasCallStack) => DeclNameLookup -> Name -> Name expectDeclName DeclNameLookup {constructorToDecl} x = case Map.lookup x constructorToDecl of Nothing -> error (reportBug "E246726" ("Expected constructor name key " <> show x <> " in decl name lookup")) Just y -> y -expectConstructorNames :: HasCallStack => DeclNameLookup -> Name -> [Name] +expectConstructorNames :: (HasCallStack) => DeclNameLookup -> Name -> [Name] expectConstructorNames DeclNameLookup {declToConstructors} x = case Map.lookup x declToConstructors of Nothing -> error (reportBug "E077058" ("Expected decl name key " <> show x <> " in decl name lookup")) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 492687e29a..ca57953a2c 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -143,7 +143,7 @@ diffNamespaceDefns = f old new = Map.mapMaybe id (alignWith g old new) - g :: Eq x => These x x -> Maybe (DiffOp x) + g :: (Eq x) => These x x -> Maybe (DiffOp x) g = \case This old -> Just (DiffOp'Delete old) That new -> Just (DiffOp'Add new) @@ -158,7 +158,7 @@ deepNamespaceDefinitionsToPpe :: Defns (BiMultimap Referent Name) (BiMultimap Ty deepNamespaceDefinitionsToPpe Defns {terms, types} = PrettyPrintEnv (arbitraryName terms) (arbitraryName types) where - arbitraryName :: Ord ref => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] + arbitraryName :: (Ord ref) => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] arbitraryName names ref = BiMultimap.lookupDom ref names & Set.lookupMin @@ -168,7 +168,7 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = -- Syntactic hashing helpers synhashDefnsWith :: - Monad m => + (Monad m) => (Name -> term -> m Hash) -> (Name -> typ -> m Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> diff --git a/unison-merge/src/Unison/Merge/Libdeps.hs b/unison-merge/src/Unison/Merge/Libdeps.hs index 61b5754417..defacf036b 100644 --- a/unison-merge/src/Unison/Merge/Libdeps.hs +++ b/unison-merge/src/Unison/Merge/Libdeps.hs @@ -72,11 +72,11 @@ mergeDiffs :: mergeDiffs alice bob = catMaybes (alignWith combineDiffOps alice bob) -combineDiffOps :: Eq a => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a) +combineDiffOps :: (Eq a) => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a) combineDiffOps = TwoDiffOps.make >>> combineDiffOps1 -combineDiffOps1 :: Eq a => TwoDiffOps a -> Maybe (LibdepDiffOp a) +combineDiffOps1 :: (Eq a) => TwoDiffOps a -> Maybe (LibdepDiffOp a) combineDiffOps1 = \case TwoDiffOps'Add new -> Just (AddLibdep (EitherWay.value new)) -- If Alice deletes a dep and Bob doesn't touch it, ignore the delete, since Bob may still be using it. diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 05787791f5..5b63f0323e 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -64,7 +64,7 @@ makeInitialIdentifyConflictsState diff = } identifyConflicts :: - HasCallStack => + (HasCallStack) => TwoWay DeclNameLookup -> TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index da9a988449..ec28369bfc 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -116,11 +116,11 @@ hashConstructorNameToken declName conName = ) in H.Text (Name.toText strippedConName) -hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash +hashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash hashDerivedTerm ppe term = H.accumulate (hashDerivedTermTokens ppe term) -hashDerivedTermTokens :: forall a v. Var v => PrettyPrintEnv -> Term v a -> [Token] +hashDerivedTermTokens :: forall a v. (Var v) => PrettyPrintEnv -> Term v a -> [Token] hashDerivedTermTokens ppe = (isNotBuiltinTag :) . (isTermTag :) . go [] where @@ -138,18 +138,18 @@ hashConstructorType = \case CT.Effect -> H.Tag 0 CT.Data -> H.Tag 1 -hashDataDeclTokens :: Var v => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] +hashDataDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] hashDataDeclTokens ppe declName (DD.DataDeclaration modifier _ bound ctors) = hashModifierTokens modifier <> (ctors >>= hashConstructorTokens ppe declName bound) -- separating constructor types with tag of 99, which isn't used elsewhere -hashConstructorTokens :: Var v => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token] +hashConstructorTokens :: (Var v) => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token] hashConstructorTokens ppe declName bound (_, conName, ty) = H.Tag 99 : hashConstructorNameToken declName (Name.unsafeParseVar conName) : hashTypeTokens ppe bound ty -hashDeclTokens :: Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token] +hashDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> [Token] hashDeclTokens ppe name decl = hashConstructorType (DD.constructorType decl) : hashDataDeclTokens ppe name (DD.asDataDecl decl) @@ -157,7 +157,7 @@ hashDeclTokens ppe name decl = -- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same, -- the constructors appear in the same order and have the same names, and the constructors' types have the same -- syntactic hashes. -synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash +synhashDerivedDecl :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> Hash synhashDerivedDecl ppe name decl = H.accumulate $ isNotBuiltinTag : isDeclTag : hashDeclTokens ppe name decl @@ -170,7 +170,7 @@ hashKindTokens k = case k of K.Star -> [H.Tag 0] K.Arrow k1 k2 -> H.Tag 1 : (hashKindTokens k1 <> hashKindTokens k2) -hashLengthToken :: Foldable t => t a -> Token +hashLengthToken :: (Foldable t) => t a -> Token hashLengthToken = H.Nat . fromIntegral @Int @Word64 . length @@ -224,7 +224,7 @@ synhashTerm loadTerm ppe = \case ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref -hashTermFTokens :: Var v => PrettyPrintEnv -> Term.F v a a () -> [Token] +hashTermFTokens :: (Var v) => PrettyPrintEnv -> Term.F v a a () -> [Token] hashTermFTokens ppe = \case Term.Int n -> [H.Tag 0, H.Int n] Term.Nat n -> [H.Tag 1, H.Nat n] @@ -255,11 +255,11 @@ hashTermFTokens ppe = \case -- | Syntactically hash a type, using reference names rather than hashes. -- Two types will have the same syntactic hash if they would -- print the the same way under the given pretty-print env. -synhashType :: Var v => PrettyPrintEnv -> Type v a -> Hash +synhashType :: (Var v) => PrettyPrintEnv -> Type v a -> Hash synhashType ppe ty = H.accumulate $ hashTypeTokens ppe [] ty -hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> [v] -> Type v a -> [Token] +hashTypeTokens :: forall v a. (Var v) => PrettyPrintEnv -> [v] -> Type v a -> [Token] hashTypeTokens ppe = go where go :: [v] -> Type v a -> [Token] @@ -286,7 +286,7 @@ hashTypeReferenceToken :: PrettyPrintEnv -> TypeReference -> Token hashTypeReferenceToken ppe = hashHQNameToken . PPE.typeNameOrHashOnlyFq ppe -hashVarToken :: Var v => [v] -> v -> Token +hashVarToken :: (Var v) => [v] -> v -> Token hashVarToken bound v = case List.elemIndex v bound of Nothing -> error (reportBug "E633940" ("var " ++ show v ++ " not bound in " ++ show bound)) diff --git a/unison-merge/src/Unison/Merge/TwoWay.hs b/unison-merge/src/Unison/Merge/TwoWay.hs index 05640a3786..bad9a928f9 100644 --- a/unison-merge/src/Unison/Merge/TwoWay.hs +++ b/unison-merge/src/Unison/Merge/TwoWay.hs @@ -80,7 +80,7 @@ twoWay f TwoWay {alice, bob} = f alice bob -- | Unzip a @Map k (TwoWay v)@ into a @TwoWay (Map k v)@. -unzipMap :: Ord k => Map k (TwoWay v) -> TwoWay (Map k v) +unzipMap :: (Ord k) => Map k (TwoWay v) -> TwoWay (Map k v) unzipMap = fromPair . unzipWith (\TwoWay {alice, bob} -> (alice, bob)) diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 5ca0c1f155..6bea3c704a 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -213,10 +213,10 @@ data BackendError = NoSuchNamespace Path.Absolute | -- Failed to parse path BadNamespace + -- | error message String - -- ^ error message + -- | namespace String - -- ^ namespace | CouldntExpandBranchHash ShortCausalHash | AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash) | AmbiguousHashForDefinition ShortHash @@ -462,11 +462,11 @@ getTermTag codebase r sig = do V2Referent.Con ref _ -> Just <$> Codebase.runTransaction codebase (Codebase.getDeclType codebase ref) pure $ if - | isDoc -> Doc - | isTest -> Test - | Just CT.Effect <- constructorType -> Constructor Ability - | Just CT.Data <- constructorType -> Constructor Data - | otherwise -> Plain + | isDoc -> Doc + | isTest -> Test + | Just CT.Effect <- constructorType -> Constructor Ability + | Just CT.Data <- constructorType -> Constructor Data + | otherwise -> Plain getTypeTag :: (Var v) => diff --git a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs index 443f064545..d69f0ac8a3 100644 --- a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs +++ b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs @@ -16,7 +16,7 @@ import Unison.Server.Types (DisplayObjectDiff (..), SemanticSyntaxDiff (..)) import Unison.Util.AnnotatedText (AnnotatedText (..)) import Unison.Util.AnnotatedText qualified as AT -diffDisplayObjects :: HasCallStack => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff +diffDisplayObjects :: (HasCallStack) => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff diffDisplayObjects from to = case (from, to) of (BuiltinObject fromST, BuiltinObject toST) -> DisplayObjectDiff (BuiltinObject (diffSyntaxText fromST toST)) (MissingObject fromSH, MissingObject toSH) diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs index d657a23e13..09ed27a12b 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs @@ -11,5 +11,5 @@ import Unison.Server.Local.Endpoints.Current (Current, CurrentEndpoint, serveCur type UCMAPI = CurrentEndpoint -ucmServer :: MonadIO m => Codebase m v a -> Backend m Current +ucmServer :: (MonadIO m) => Codebase m v a -> Backend m Current ucmServer codebase = serveCurrent codebase diff --git a/unison-syntax/src/Unison/Lexer/Pos.hs b/unison-syntax/src/Unison/Lexer/Pos.hs index 9286d36b05..e78bb61c88 100644 --- a/unison-syntax/src/Unison/Lexer/Pos.hs +++ b/unison-syntax/src/Unison/Lexer/Pos.hs @@ -10,7 +10,7 @@ type Line = Int type Column = Int -data Pos = Pos { line :: {-# UNPACK #-} !Line, column :: {-# UNPACK #-} !Column} deriving (Show, Eq, Ord) +data Pos = Pos {line :: {-# UNPACK #-} !Line, column :: {-# UNPACK #-} !Column} deriving (Show, Eq, Ord) instance Semigroup Pos where Pos line col <> Pos line2 col2 = diff --git a/unison-syntax/src/Unison/Syntax/HashQualified.hs b/unison-syntax/src/Unison/Syntax/HashQualified.hs index 927f548805..9cc25f61cc 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualified.hs @@ -66,7 +66,7 @@ toVar = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HashQualified name) hashQualifiedP nameP = diff --git a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs index 6326006c7a..406a8eae2f 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs @@ -48,7 +48,7 @@ toText = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HQ'.HashQualified name) hashQualifiedP nameP = diff --git a/unison-syntax/src/Unison/Syntax/Name.hs b/unison-syntax/src/Unison/Syntax/Name.hs index 17112b6b95..a0de444b2b 100644 --- a/unison-syntax/src/Unison/Syntax/Name.hs +++ b/unison-syntax/src/Unison/Syntax/Name.hs @@ -85,7 +85,7 @@ toText (Name pos (x0 :| xs)) = Relative -> "" -- | Parse a name from a var, by first rendering the var as a string. -parseVar :: Var v => v -> Maybe Name +parseVar :: (Var v) => v -> Maybe Name parseVar = parseText . Var.name @@ -105,7 +105,7 @@ toVar = -- Name parsers -- | A name parser. -nameP :: Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name +nameP :: (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name nameP = P.try do leadingDot <- isJust <$> P.optional (P.char '.') @@ -113,7 +113,7 @@ nameP = pure (if leadingDot then Name.makeAbsolute name else name) -- | A relative name parser. -relativeNameP :: forall m. Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name +relativeNameP :: forall m. (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name relativeNameP = do Name.fromSegments <$> Monad.sepBy1 NameSegment.segmentP separatorP where @@ -123,7 +123,7 @@ relativeNameP = do -- This allows (for example) the "a." in "forall a. a -> a" to successfully parse as an identifier "a" followed by -- the reserved symbol ".", rathern than fail to parse as an identifier, because it looks like the prefix of some -- "a.b" that stops in the middle. - separatorP :: Ord e => ParsecT e [Char] m Char + separatorP :: (Ord e) => ParsecT e [Char] m Char separatorP = P.try do c <- P.char '.' diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 015537c467..affab5bf2c 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -280,7 +280,7 @@ semi = label "newline or semicolon" $ queryToken go closeBlock :: (Ord v) => P v m (L.Token ()) closeBlock = void <$> matchToken L.Close -wordyPatternName :: Var v => P v m (L.Token v) +wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n _ -> Nothing @@ -304,27 +304,27 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName _ -> Nothing -- Parse a wordy identifier e.g. Foo, discarding any hash -wordyDefinitionName :: Var v => P v m (L.Token v) +wordyDefinitionName :: (Var v) => P v m (L.Token v) wordyDefinitionName = queryToken $ \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing -- Parse a wordyId as a Name, rejecting any hash -importWordyId :: Ord v => P v m (L.Token Name) +importWordyId :: (Ord v) => P v m (L.Token Name) importWordyId = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just n L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s)) _ -> Nothing -- The `+` in: use Foo.bar + as a Name -importSymbolyId :: Ord v => P v m (L.Token Name) +importSymbolyId :: (Ord v) => P v m (L.Token Name) importSymbolyId = queryToken \case L.SymbolyId (HQ'.NameOnly n) -> Just n _ -> Nothing -- Parse a symboly ID like >>= or &&, discarding any hash -symbolyDefinitionName :: Var v => P v m (L.Token v) +symbolyDefinitionName :: (Var v) => P v m (L.Token v) symbolyDefinitionName = queryToken $ \case L.SymbolyId n -> Just $ Name.toVar (HQ'.toName n) _ -> Nothing @@ -345,7 +345,7 @@ hqPrefixId = hqWordyId_ <|> parenthesize hqSymbolyId_ hqInfixId = hqSymbolyId_ -- Parse a hash-qualified alphanumeric identifier -hqWordyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name)) +hqWordyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqWordyId_ = queryToken \case L.WordyId n -> Just $ HQ'.toHQ n L.Hash h -> Just $ HQ.HashOnly h @@ -353,7 +353,7 @@ hqWordyId_ = queryToken \case _ -> Nothing -- Parse a hash-qualified symboly ID like >>=#foo or && -hqSymbolyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name)) +hqSymbolyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqSymbolyId_ = queryToken \case L.SymbolyId n -> Just (HQ'.toHQ n) _ -> Nothing @@ -409,7 +409,7 @@ string = queryToken getString -- -- returns the result of combining elements with 'pair', alongside the annotation containing -- the full parenthesized expression. -tupleOrParenthesized :: Ord v => P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann {- spanAnn -}, a) +tupleOrParenthesized :: (Ord v) => P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann {- spanAnn -}, a) tupleOrParenthesized p unit pair = do seq' "(" go p where