pull some weeds

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -17,8 +17,8 @@
 {-# LANGUAGE TypeOperators #-}
 module U.Codebase.Sqlite.Queries where
 
-import Control.Monad (filterM, when)
-import Control.Monad.Except (ExceptT, MonadError, runExceptT)
+import Control.Monad (when)
+import Control.Monad.Except (MonadError)
 import qualified Control.Monad.Except as Except
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Reader (MonadReader (ask))
@@ -40,7 +40,6 @@ import Database.SQLite.Simple
   ( Connection,
     FromRow,
     Only (..),
-    SQLData,
     ToRow (..),
     (:.) (..),
   )
@@ -101,7 +100,6 @@ data Integrity
   | UnknownObjectId ObjectId
   | UnknownCausalHashId CausalHashId
   | UnknownHash Hash
-  | UnknownText Text
   | NoObjectForHashId HashId
   | NoObjectForPrimaryHashId HashId
   | NoNamespaceRoot
@@ -111,13 +109,6 @@ data Integrity
   | NoTypeIndexForTerm Referent.Id
   deriving (Show)
 
--- | discard errors that you're sure are impossible
-noExcept :: (Monad m, Show e) => ExceptT e m a -> m a
-noExcept a =
-  runExceptT a >>= \case
-    Right a -> pure a
-    Left e -> error $ "unexpected error: " ++ show e
-
 orError :: Err m => Integrity -> Maybe b -> m b
 orError e = maybe (throwError e) pure
 
@@ -189,9 +180,6 @@ loadText :: DB m => Text -> m (Maybe TextId)
 loadText t = queryAtom sql (Only t)
   where sql = [here| SELECT id FROM text WHERE text = ? |]
 
-expectText :: EDB m => Text -> m TextId
-expectText t = loadText t >>= orError (UnknownText t)
-
 loadTextById :: EDB m => TextId -> m Text
 loadTextById h = queryAtom sql (Only h) >>= orError (UnknownTextId h)
   where sql = [here| SELECT text FROM text WHERE id = ? |]
@@ -266,21 +254,6 @@ loadPrimaryHashByObjectId oId = queryAtom sql (Only oId) >>= orError (UnknownObj
   WHERE object.id = ?
 |]
 
-objectAndPrimaryHashByAnyHash :: EDB m => Base32Hex -> m (Maybe (Base32Hex, ObjectId))
-objectAndPrimaryHashByAnyHash h = runMaybeT do
-  hashId <- MaybeT $ loadHashId h -- hash may not exist
-  oId <- MaybeT $ maybeObjectIdForAnyHashId hashId -- hash may not correspond to any object
-  base32 <- loadPrimaryHashByObjectId oId
-  pure (base32, oId)
-
-objectExistsWithHash :: DB m => Base32Hex -> m Bool
-objectExistsWithHash h = queryExists sql (Only h) where
-  sql = [here|
-    SELECT 1
-    FROM hash INNER JOIN hash_object ON hash.id = hash_object.hash_id
-    WHERE base32 = ?
-  |]
-
 hashIdsForObject :: DB m => ObjectId -> m (NonEmpty HashId)
 hashIdsForObject oId = do
   primaryHashId <- queryOne $ queryAtom sql1 (Only oId)
@@ -603,10 +576,6 @@ queryAtom q r = fmap fromOnly <$> queryMaybe q r
 queryOne :: Functor f => f (Maybe b) -> f b
 queryOne = fmap fromJust
 
--- | composite input, Boolean output
-queryExists :: (DB m, ToRow q, Show q) => SQLite.Query -> q -> m Bool
-queryExists q r = not . null . map (id @SQLData) <$> queryAtoms q r
-
 -- | composite input, composite List output
 query :: (DB m, ToRow q, FromRow r, Show q, Show r) => SQLite.Query -> q -> m [r]
 query q r = do

codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs

@@ -16,11 +16,7 @@ import Data.Bytes.Serial (SerialEndian (serializeBE), deserialize, deserializeBE
 import Data.Bytes.VarInt (VarInt (VarInt), unVarInt)
 import Data.Int (Int64)
 import Data.List (elemIndex)
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
 import Data.Word (Word64)
 import Debug.Trace (trace)
 import qualified U.Codebase.Decl as Decl
@@ -638,9 +634,6 @@ getBranchLocalIds =
     <*> getVector getVarInt
     <*> getVector (getPair getVarInt getVarInt)
 
-vec2seq :: Vector a -> Seq a
-vec2seq v = Seq.fromFunction (length v) (v Vector.!)
-
 decomposeComponent :: MonadGet m => m [(LocalIds, BS.ByteString)]
 decomposeComponent = do
   offsets <- getList (getVarInt @_ @Int)

codebase2/codebase/U/Codebase/Type.hs

@@ -58,11 +58,6 @@ rmap f = ABT.transform \case
   Ref r -> Ref (f r)
   x -> unsafeCoerce x
 
-rtraverse :: (Monad g, Ord v) => (r -> g r') -> ABT.Term (F' r) v a -> g (ABT.Term (F' r') v a)
-rtraverse g = ABT.transformM \case
-  Ref r -> Ref <$> g r
-  x -> pure $ unsafeCoerce x
-
 typeD2T :: Ord v => Hash -> TypeD v -> TypeT v
 typeD2T h = rmap $ bimap id $ Maybe.fromMaybe h
 

codebase2/codebase/U/Codebase/TypeEdit.hs

@@ -7,14 +7,6 @@ import qualified U.Util.Hashable as H
 data TypeEdit = Replace Reference | Deprecate
   deriving (Eq, Ord, Show)
 
-references :: TypeEdit -> [Reference]
-references (Replace r) = [r]
-references Deprecate = []
-
 instance Hashable TypeEdit where
   tokens (Replace r) = H.Tag 0 : H.tokens r
   tokens Deprecate   = [H.Tag 1]
-
-toReference :: TypeEdit -> Maybe Reference
-toReference (Replace r) = Just r
-toReference Deprecate     = Nothing

codebase2/core/U/Core/ABT.hs

@@ -18,10 +18,7 @@ import qualified Data.Set as Set
 import qualified Data.Foldable as Foldable
 import Prelude hiding (abs,cycle)
 import U.Util.Hashable (Accumulate, Hashable1)
-import Data.Map (Map)
-import qualified Data.Map as Map
 import qualified U.Util.Hashable as Hashable
-import Data.Functor (void)
 import qualified Data.List as List
 import qualified Data.Vector as Vector
 import Control.Monad (join)
@@ -55,13 +52,6 @@ vmap f (Term _ a out) = case out of
   Cycle r -> cycle a (vmap f r)
   Abs v body -> abs a (f v) (vmap f body)
 
-vtraverse :: (Traversable f, Applicative g, Ord v') => (v -> g v') -> Term f v a -> g (Term f v' a)
-vtraverse g (Term _ a out) = case out of
-  Var v -> var a <$> g v
-  Cycle r -> cycle a <$> vtraverse g r
-  Abs v r -> abs a <$> g v <*> vtraverse g r
-  Tm fa -> tm a <$> traverse (vtraverse g) fa
-
 transform :: (Ord v, Foldable g, Functor g)
           => (forall a. f a -> g a) -> Term f v a -> Term g v a
 transform f t = case out t of
@@ -87,12 +77,6 @@ var a v = Term (Set.singleton v) a (Var v)
 cycle :: a -> Term f v a -> Term f v a
 cycle a t = Term (freeVars t) a (Cycle t)
 
-absChain' :: Ord v => [v] -> Term f v () -> Term f v ()
-absChain' vs t = foldr (\v t -> abs () v t) t vs
-
-absCycle' :: Ord v => [v] -> Term f v () -> Term f v ()
-absCycle' vs t = cycle () $ absChain' vs t
-
 tm :: (Foldable f, Ord v) => a -> f (Term f v a) -> Term f v a
 tm a t = Term (Set.unions (fmap freeVars (Foldable.toList t))) a (Tm t)
 
@@ -125,26 +109,6 @@ hash = hash' [] where
       env -> (map (hash' env) ts', hash' env)
   hashCycle env ts = (map (hash' env) ts, hash' env)
 
--- Hash a strongly connected component and sort its definitions into a canonical order.
-hashComponent ::
-  (Functor f, Hashable1 f, Foldable f, Eq v, Show v, Ord v, Ord h, Accumulate h)
-  => Map v (Term f v a) -> (h, [(v, Term f v a)])
-hashComponent byName = let
-  ts = Map.toList byName
-  embeds = [ (v, void (transform Embed t)) | (v,t) <- ts ]
-  vs = fst <$> ts
-  -- make closed terms for each element of the component
-  -- [ let x = ..., y = ..., in x
-  -- , let x = ..., y = ..., in y ]
-  -- so that we can then hash them (closed terms can be hashed)
-  -- so that we can sort them by hash. this is the "canonical, name-agnostic"
-  --   hash that yields the canonical ordering of the component.
-  tms = [ (v, absCycle' vs (tm () $ Component (snd <$> embeds) (var () v))) | v <- vs ]
-  hashed  = [ ((v,t), hash t) | (v,t) <- tms ]
-  sortedHashed = List.sortOn snd hashed
-  overallHash = Hashable.accumulate (Hashable.Hashed . snd <$> sortedHashed)
-  in (overallHash, [ (v, t) | ((v, _),_) <- sortedHashed, Just t <- [Map.lookup v byName] ])
-
 -- Implementation detail of hashComponent
 data Component f a = Component [a] a | Embed (f a) deriving (Functor, Traversable, Foldable)
 instance (Hashable1 f, Functor f) => Hashable1 (Component f) where

codebase2/util/U/Util/Base32Hex.hs

@@ -27,12 +27,6 @@ toByteString :: Base32Hex -> ByteString
 toByteString = fromMaybe err . textToByteString . toText
   where err = "invalid base32Hex presumably created via \"unsafe\" constructors"
 
-fromText :: Text -> Maybe Base32Hex
-fromText = fmap fromByteString . textToByteString
-
-unsafeFromText :: Text -> Base32Hex
-unsafeFromText = UnsafeBase32Hex
-
 -- | Produce a 'Hash' from a base32hex-encoded version of its binary representation
 textToByteString :: Text -> Maybe ByteString
 textToByteString txt =

codebase2/util/U/Util/Cache.hs

@@ -15,9 +15,6 @@ data Cache m k v =
         , insert :: k -> v -> m ()
         }
 
-transform :: (forall a. m a -> n a) -> Cache m k v -> Cache n k v
-transform f Cache {..} = Cache (f . lookup) ((f .) . insert)
-
 -- Create a cache of unbounded size.
 cache :: (MonadIO m, Ord k) => m (Cache m k v)
 cache = do

weeder.dhall

@@ -0,0 +1 @@
+{ roots = [ "^Main.main$", "^Paths_.*" ], type-class-roots = True }