TypeLenses soft-crashes when opening this file

[dansanduleac]

Your environment

Output of haskell-language-server --probe-tools or haskell-language-server-wrapper --probe-tools:

haskell-language-server version: 1.2.0.0 (GHC: 8.10.4) (PATH: /Users/admin/.ghcup/bin/haskell-language-server-wrapper-1.2.0) (GIT hash: 8cfe8b2dbdef965ed735a66de38af425809ae48d)
Tool versions found on the $PATH
cabal:		3.4.0.0
stack:		2.5.1.1
ghc:		Not found

Which OS do you use: MacOS
Which lsp-client do you use: VS Code
Describe your project (alternative: link to the project):

package.yaml (excerpt):

dependencies:
- base >= 4.7 && < 5
- http-client
- http-client-tls
- http-conduit
- wreq
- text
- lens
- lens-aeson
- lens-errors
- aeson
- yaml
- cassava
- cryptohash-sha256
- base16-bytestring
- bytestring
- http-api-data
- time
- safe-exceptions 
- http-api-data
- http-media
- http-types
- iso8601-time
- either-unwrap
- transformers
- filepath
- directory
- cond
- retry
- unordered-containers
- Decimal
- containers
- concurrency
- parallel-io
- scientific
- attoparsec
- generic-data-surgery
- vector
- raw-strings-qq
- hashable
- regex-pcre >= 0.95.0
- regex-base >= 0.94.0
- shake
- har
- text-format
- formatting
- extra
- profunctors
- cookie
- monad-validate
- binary
- random
- reflection
- tagged
- statistics
- named
- mmorph
- vty
- websockets
- network


default-extensions:
  - DataKinds
  - FlexibleContexts
  - GADTs
  - LambdaCase
  - PolyKinds
  - RankNTypes
  - ScopedTypeVariables
  - TypeApplications
  - TypeOperators
  - TypeFamilies
  - OverloadedStrings
  - NoImplicitPrelude
  - ViewPatterns
  - NamedFieldPuns
  - TupleSections
  - NumericUnderscores

stack.yaml

resolver: lts-17.5
packages:
  - .
extra-deps:
  - either-unwrap-1.1@sha256:bd9a8cc3ce127b0f922db4da0b3eb25036034406dd40c954d3f8aa6fe5aab313,605
  - cached-0.1.0.0@sha256:50edd08b356f5339f0d975011a56ef9acc3f91c9baa586f7ae45e2fd70d3d8a8,2365
  - lens-errors-0.2.2.0@sha256:6d476b7fb6516fd8a59b3c901a9f6f3289a1a0fb4ea5d5b30976e41be9e75276,1510
  - monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
  - named-0.3.0.1@sha256:2975d50c9c5d88095026ffc1303d2d9be52e5f588a8f8bcb7003a04b79f10a06,2312
system-ghc: true
extra-path:
  # make sure the x86_64 pkg-config is picked up
  - /usr/local/bin

Contents of hie.yaml:

cradle:
  stack:

Steps to reproduce

Open my stack project.
As long as Build.hs is not an open tab, the HLS loads the project just fine.
If Build.hs is already open, or once I open it, almost immediately HLS will stop working.
Type lenses must be turned on in the config.

Here's Build.hs in its entirety.

{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
-- Brittany complains:  Illegal keyword 'type' (use ExplicitNamespaces to enable)
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE StandaloneDeriving         #-}

{-# LANGUAGE FunctionalDependencies     #-}
module Build
    ( Cached
    , CachedFun(..)
    , module Exports
    , Json(..)
    , asOracle
    , cacheJson
    , cacheMany
    , cacheMany'
    , cacheDynMany
    , cacheDynMany'
    , cachedFun
    , cachedFunRmap
    , cachedOkOrFail
    , decodeCached
    , decodeCached'
    , fromIO
    , fromIO'
    , parseJson
    , mapCachedIO
    , mapCachedAction
    , memoize
    , runCached
    , swallowErrors
    , type (~>)
    -- lenses
    , _cachedFunFn
    ) where

import qualified Control.Exception.Safe        as E
import           Prelouder               hiding ( Traversing
                                                , doesFileExist
                                                , unpack
                                                )


-- Build system stuff
import qualified Data.Binary                   as Binary
import           Development.Shake             as Exports
                                         hiding ( (*>) )
import           Development.Shake.Classes     as Exports
import           Development.Shake.FilePath    as Exports

import           Data.Either.Unwrap
import           Data.Functor.Identity
import           Data.Tagged
import qualified Data.Text                     as T
import qualified Data.Text.Lazy                as TL
import qualified Data.Text.Lazy.Builder        as TL


import qualified Control.Category              as Cat
import           Control.Concurrent.MVar
import           Control.Monad.Extra
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.State.Lazy
import           Control.Monad.Validate
import qualified Data.ByteString.Lazy          as LBS
import           Data.Set                      as Set
import qualified System.Directory              as IO

import           Control.Concurrent.Extra
import           Control.Monad.Morph            ( hoist )
import           Control.Monad.Trans.Writer.Strict
import           Data.Bifunctor
import qualified Data.HashMap.Strict           as HM
import           Data.Profunctor
import           Data.Profunctor.Traversing
import           Data.Profunctor.Unsafe
import           Data.Proxy                     ( Proxy(..) )
import           Debug.Trace                    ( trace
                                                , traceIO
                                                )
import qualified Development.Shake             as Shake
import           GHC.Stack                      ( HasCallStack )
import qualified Prelouder                     as P


type Errs = [Text]

-- <*> High-level functions

-- | Cache the json-able value produced by the given 'Cached'.
cacheJson
    :: (FromJSON a, ToJSON a)
    => FilePath -- ^ output path
    -> Cached a
    -> Rules (Cached a)
cacheJson path = cacheIO path
                         (encodeFile path)
                         (mapLeft pack <$> eitherDecodeFileStrict path)

parseJson :: FromJSON a => FilePath -> Cached a
parseJson path = fromIO'
    [path]
    (   Identity
    .   ExceptT
    $   mapLeft ((: []) . pack)
    <$> eitherDecodeFileStrict path
    )

-- | It's normally impossible to map Cached through an IO effect, so this function allows that.
mapCachedIO
    :: (Functor f, IsCache c, F c ~ f)
    => (Set FilePath -> a -> ExceptT [Text] Action b)
    -> c a
    -> c b
mapCachedIO f = mapCachedIO' f'
    where f' needs = lift . exceptToValidateLiftedWith id . f needs

mapCachedIO'
    :: (Functor f, IsCache c, F c ~ f)
    => (Set FilePath -> a -> WithFinalizer ValidateIO b)
    -> c a
    -> c b
mapCachedIO' f =
    internal . _Wrapped . mapped %~ mapBuilderTemplate (bindTemplate f)


mapCachedAction
    :: (Functor f, IsCache c, F c ~ f) => (Action ~> Action) -> c a -> c a
mapCachedAction f = internal . _Wrapped . mapped %~ mapBuilderTemplate (wrap f)
  where
    wrap (f :: Action ~> Action) ActionTemplate { readValue, needs } =
        ActionTemplate
            { readValue = mapWriterT
              -- it's really a pain to unwrap and rewrap a ValidateT
                              ( exceptToValidateLiftedWith id
                              . ExceptT
                              . f
                              . runValidateT
                              )
                              readValue
            , needs
            }

bindTemplate
    :: Monad mt
    => (Set FilePath -> a -> WithFinalizer mt b)
    -> ActionTemplateT mt a
    -> ActionTemplateT mt b
bindTemplate f ActionTemplate { readValue, needs } =
    ActionTemplate { readValue = readValue >>= f needs, needs }

-- Absorb an explicit error into the cache read operation.
cachedOkOrFail
    :: (Functor f, IsCache c, F c ~ f) => (e -> [Text]) -> c (Either e b) -> c b
cachedOkOrFail f = mapCachedIO (const $ except . mapLeft f)
{-# INLINE cachedOkOrFail #-}

swallowErrors :: IsCache c => c (Either [Text] a) -> c a
swallowErrors = over internal (cachedOkOrFail id)


-- | Memoize a 'CachedFun' so its read action only ever gets run once per k.
memoize :: ShakeValue k => CachedFun k a -> Rules (CachedFun k a)
memoize (FunBuilder builder) = do
    -- here, want to unwrap then re-wrap ActionBuilder...
    let
        fAction =
            Prelouder.first builder
                >>> (\(ActionBuilder a, r) -> runReaderT a r)
    cached <- newCache fAction
    return
        . CachedFun
        $ (curry cached >>> ReaderT >>> ActionBuilder >>^ BasicBuilder)


data InputValue t k a = InputValue
    { key :: Tagged t k
    , ctx :: Ctx
    -- TODO do we need valueProxy?
    }
    deriving (Generic, Show, Typeable, Eq, Hashable, NFData)

instance Hashable k => Hashable (Tagged t k) where
    hashWithSalt salt (untag -> k) = hashWithSalt salt k

instance Binary k => Binary (InputValue t k a) where
    put InputValue { key, ctx } = Binary.put (untag key) >> Binary.put ctx
    get =
        (\(Tagged -> key) ctx -> InputValue { key, ctx })
            <$> Binary.get
            <*> Binary.get
type instance RuleResult (InputValue ctx k a) = a

-- NOTE: this is to test the generalisation of 't' across different kinds
-- baz :: forall t. (ShakeValue (InputValue t () ())) => Rules (InputValue t () () -> Action ())
-- baz :: forall (t :: forall k. k). (ShakeValue (Tagged t ())) => Rules (InputValue t () () -> Action ())
baz
    :: forall k (t :: k)
     . (Typeable t, Typeable k)
    => Rules (InputValue t () () -> Action ())
baz = addOracle (\InputValue { key, ctx } -> return ())

newtype Foo = Foo ()
    deriving (Generic, Show, Typeable, Eq)
    deriving anyclass (Hashable, Binary, NFData)

data Bar = X | Y
    deriving (Generic, Show, Typeable, Eq)
    deriving anyclass (Hashable, Binary, NFData)

tryThis00 = baz @_ @Foo
tryThis10 = baz @_ @X
tryThis11 = baz :: Rules (InputValue 'X () () -> Action ())

-- | Mark the function 'CacheFun k a' as an oracle, so that the action
-- reruns whenever the function returns something else compared to previous runs.
asOracle
    :: forall tk (t :: tk) k a
     . (ShakeValue (InputValue t k a), ShakeValue a)
    => Proxy t
    -> CachedFun k a
    -> Rules (CachedFun k a)
asOracle _ (CachedFun fb) = do
    oracle <- addOracle $ \(InputValue { key, ctx } :: InputValue t k a) ->
                        -- fprintln ("Asking for " % shown) key
                        -- before, builder = the cachedBuilder
                        -- now it's
        flip runReaderT ctx . flatToAction . fb . untag $ key

    return . CachedFun . rmap (BasicBuilder . ActionBuilder) $ newAction oracle
  where
    newAction oracle k = do
          -- fprintln ("Oracle asked: " % shown) k
        ctx    <- ask
        result <- lift $ oracle (InputValue (Tagged k) ctx)
        return $ pure result
    flatToAction (BasicBuilder (ActionBuilder b)) =
        b >>= (lift . actionTemplateToAction)

-- | Decode a 'Cached' 'ByteString' value as JSON.
decodeCached
    :: (Functor f, IsCache c, F c ~ f, FromJSON a) => c LBS.ByteString -> c a
decodeCached =
    toExternal
        . mapCachedIO (\_ (Right a) -> pure a)
        . decodeCached'
        . fmap Right
        . toInternal

-- | Decode a 'Cached' 'ByteString' value as JSON, allowing for user errors.
decodeCached'
    :: (Functor f, IsCache c, F c ~ f, FromJSON a, m ~ Either e)
    => c (m LBS.ByteString)
    -> c (m a)
decodeCached' = mapCachedIO
    (\needs -> \case
        Left x -> ExceptT . pure . pure $ Left x
        Right y ->
            withExceptT
                    (   sformat
                            ( "Failed to decode cached JSON value from files "
                            % build
                            % ": "
                            % string
                            )
                            (Set.toList needs)
                    >>> (: [])
                    )
                . ExceptT
                . pure
                . fmap pure
                . eitherDecode'
                $ y
    )

class Cacheable c d | c -> d where
    readFrom :: FilePath -> IO (Either Text c)
    writeTo :: FilePath -> c -> IO ()
    unpack :: c -> d

newtype Json a = Json a
instance Cacheable LBS.ByteString LBS.ByteString where
    readFrom = fmap Right . LBS.readFile
    writeTo  = LBS.writeFile
    unpack   = id

instance (FromJSON a, ToJSON a) => Cacheable (Json a) a where
    readFrom = fmap (right Json . left pack) . eitherDecodeFileStrict'
    writeTo fp (Json a) = encodeFile fp a
    unpack (Json a) = a

cacheMany
    :: Cacheable c d
    => FilePath -- ^ root path
    -> (id -> String) -- ^ id to path segment (without extension)
    -> (String -> id) -- ^ path segment (without extension) to id
    -> String -- ^ extension
    -> (id -> Cached c) -- ^ compute
    -> Rules (CachedFun id d)
cacheMany rootPath idToPath pathToId ext compute =
    cachedFunRmap (cachedOkOrFail (\() -> [])) <$> cacheMany'
        rootPath
        idToPath
        pathToId
        ext
        (compute >>^ fmap Right)

-- | Cache many files. In case an exception occurs, it will be stored instead.
cacheMany'
    :: (ToJSON e, FromJSON e, Cacheable c d)
    => FilePath -- ^ root path
    -> (id -> String) -- ^ id to path segment (without extension)
    -> (String -> id) -- ^ path segment (without extension) to id
    -> String -- ^ extension
    -> (id -> Cached (Either e c)) -- ^ compute
    -> Rules (CachedFun id (Either e d))
-- cacheMany rootPath idToPath id | isAbsolute $ idToPath id =
    -- error "idToPath should return a relative path"
cacheMany' rootPath idToPath pathToId ext compute =
    rmap (fmap unpack)
        .   CachedFun
        <$> cacheIO' (rootPath <//> "*")
                     path
                     writeAction
                     readAction
                     (\path idToA -> idToA . pathToId $ takeBaseName path)
                     compute
  where
    readAction  = jsonReadAction . path
    writeAction = jsonWriteAction . path
    path id = rootPath </> idToPath id <.> ext


jsonWriteAction
    :: (Cacheable c d, ToJSON a)
    => FilePath
    -> Either a c
    -> WithFinalizer IO ()
jsonWriteAction path =
    let goodPath    = path
        badPath     = failedPath path
        writeGood   = writeTo path
        writeFailed = encodeFile badPath
    in  either
            (\err -> do
                liftIO $ writeTo path LBS.empty >> writeFailed err
                tell $ trackWrite [badPath]
            )
            (\ok -> liftIO $ do
                writeGood ok
                -- Here we don't use Shake.doesFileExist since we delete the file
                -- as a cleanup, we don't want it to be tracked as a dep.
                -- Also docs say the result of doesFileExist shouldn't change from
                -- the beginning to the end of the build.
                whenM (IO.doesFileExist badPath) (IO.removeFile badPath)
            )

jsonReadAction
    :: (FromJSON a, Cacheable c d)
    => FilePath
    -> WithFinalizer IO (Either Text (Either a c))
jsonReadAction path = do
    let badPath = failedPath path
    failedFileExists <- liftIO $ P.doesFileExist badPath
    -- have shake register that we asked for this file
    tell . void $ Shake.doesFileExist badPath
    if failedFileExists
        then
            liftIO
            $ fmap join
            . tryInner
            . fmap (left pack . fmap Left)
            . eitherDecodeFileStrict'
            $ badPath
        else
            liftIO $ fmap join . tryInner . fmap (right Right) . readFrom $ path
    where tryInner = fmap (mapLeft (pack . show)) . E.tryAny

failedPath :: FilePath -> FilePath
failedPath path = path <.> "failed"


cacheDynMany
    :: (Eq id, Hashable id, Cacheable c d)
    => FilePath -- ^ root path
    -> (id -> String) -- ^ id to path (including extension)
    -> (id -> Cached c) -- ^ compute
    -> Rules (CachedFun id d)
cacheDynMany rootPath idToPath compute =
    over _cachedFunFn (rmap $ cachedOkOrFail (\() -> []))
        <$> cacheDynMany' rootPath idToPath (compute >>^ fmap Right)


cacheDynMany'
    :: (Eq id, Hashable id, ToJSON e, FromJSON e, Cacheable c d)
    => FilePath -- ^ root path
    -> (id -> String) -- ^ id to subpath (including extension)
    -> (id -> Cached (Either e c)) -- ^ compute
    -> Rules (CachedFun id (Either e d))
cacheDynMany' rootPath idToPath compute =
    rmap (fmap unpack)
        <$> dynCacheIO (rootPath <//> "*") path writeAction readAction compute
  where
    readAction  = jsonReadAction . path
    writeAction = jsonWriteAction . path
    path id = rootPath </> idToPath id


-- also, lift function
fromIO :: Functor f => [FilePath] -> f (IO a) -> Cached1 f a
fromIO needs fio = fromIO' needs (lift <$> fio)

fromIO' :: Functor f => [FilePath] -> f (ExceptT Errs IO a) -> Cached1 f a
fromIO' needs = fromIOWithFinalizer needs . fmap lift

fromIOWithFinalizer
    :: Functor f
    => [FilePath]
    -> f (WithFinalizer (ExceptT Errs IO) a)
    -> Cached1 f a
fromIOWithFinalizer (Set.fromList -> needs) fio =
    Cached1
        $   makeBuilder
        .   hoist (exceptToValidateLiftedWith id . hoist liftIO . tryInner)
        <$> fio
  where
    tryInner = either (throwE . (: []) . pack . show) pure <=< E.tryAny
    makeBuilder readValue = ActionBuilder $ do
        return $ ActionTemplate { readValue, needs }

-- | A convenient way to print a trace using a formatter.
tracedf :: Format (Action ()) a -> a
tracedf f = runFormat f formatter
    where formatter fmt = traced (TL.unpack . TL.toLazyText $ fmt) (pure ())


-- | Caching with arbitrary IO actions, specialized to Cached.
cacheIO
    :: FilePath
    -> (a -> IO ())
    -> IO (Either Text a)
    -> Cached a
    -> Rules (Cached a)
cacheIO path write read =
    fmap runIdentity
        . cacheIO' path
                   (Identity path)
                   (Identity . rmap liftIO $ write)
                   (Identity . liftIO $ read)
                   (const runIdentity)
        . Identity

-- | A generalized way to cache multiple files under a rootPattern.
-- I don't know if [f] makes sense to be anything else besides a function
-- [(->) id].
--
-- Uses a single shake rule, but needs a 'selector' to recover the
-- computation from a given file's base name.
cacheIO'
    :: forall f a
     . (Monad f)
    => FilePattern -- ^ rootPattern
    -> f FilePath -- ^ fPath
    -> f (a -> WithFinalizer IO ()) -- ^ fWrite
    -> f (WithFinalizer IO (Either Text a)) -- ^ fRead
    -> (forall a . FilePath -> f a -> a) -- ^ selector
    -> f (Cached a)
    -> Rules (f (Cached a))
cacheIO' rootPattern fPath fWrite fRead selector fCached =
--     if isBuilt path (cacheBuild a)
--   then CacheFail ("The cache file already exists: " <> pack path)

    saveCachedRule $> (readSavedCached <$> fPath <*> fRead)

  where
    selector' :: Selector f
    selector'      = rmap pure . selector
    -- Rule that computes and saves the cached value.
    saveCachedRule = buildOne rootPattern selector' saveCached
    -- Read the value for the output, ideally reads what was saved by 'saveCached'
    -- void action that reads the fCached and saves it using fWrite.
    -- NOTE: not sure if this can work with anything else but Identity, i.e.
    --   fCached :: f (Cached1 Identity a)
    saveCached     = do
        write <- fWrite
        basicBuilder . mapCachedIO' (const $ hoist liftIO . write) <$> fCached
    -- tryInner = validateT . mapLeft ((: []) . pack . show) <=< E.tryAny
    ---------------------------------------------------------------------------
    readSavedCached path read = BasicBuilder (makeReadAction path read)
    makeReadAction path read = ActionBuilder $ do
        -- Ensure rootPattern matches path
        unless (rootPattern ?== path) (fail $ "Bad path: " ++ path)

        return ActionTemplate
            { readValue = (validateT <=< hoist liftIO)
                          $   Data.Bifunctor.first errMsg
                          <$> read
            , needs     = Set.singleton path
            }
        where errMsg e = ["Error reading file " <> pack path <> ": " <> e]


-- Caching a function where we automatically keep track of which inputs produced which resulting path.
dynCacheIO
    :: (HasCallStack, Eq i, Hashable i)
    => FilePattern -- ^ rootPattern
    -> (i -> FilePath) -- ^ fPath
    -> (i -> a -> WithFinalizer IO ()) -- ^ fWrite
    -> (i -> WithFinalizer IO (Either Text a)) -- ^ fRead
    -> (i -> Cached a)
    -> Rules (CachedFun i a)
dynCacheIO rootPattern fPath fWrite fRead fCached = do
    -- Create the rule to save the results, but only once per key
    -- The second time this is retrieved for the same key, it will do nothing.

    -- idFromPath :: FilePath -> Action i
    idToPathMap <- liftIO $ newVar HM.empty
    saveCachedRule (lookupFromCache idToPathMap) $> CachedFun
        (\i -> do
            let path = fPath i
            liftIO (saveToCache idToPathMap path i)
            readSavedCached path (fRead i)
        )
  where
    lookupFromCache var k = fromJust . HM.lookup k <$> liftIO (readVar var)
    saveToCache var k value = modifyVar_ var $ pure . HM.insert k value
    -- Rule that computes and saves the cached value.
    -- f is 'Kleisli Action i a'
    saveCachedRule pathToId =
        buildOne rootPattern (selector pathToId) saveCached
    -- Use pathToId to figure out the id, then flatmap that onto the 2nd "idToAction"
    -- parameter (i.e. saveCached)
    selector pathToId =
        \path idToAction -> pathToId path >>= runKleisli idToAction
    saveCached =
        arr $ \i -> saveCached' (rmap (hoist liftIO) (fWrite i)) (fCached i)
    saveCached' write = basicBuilder . mapCachedIO' (const write)
    -- tryInner = validateT . mapLeft ((: []) . pack . show) <=< E.tryAny
    ---------------------------------------------------------------------------
    readSavedCached path read =
        Cached1 { cacheBuilder = Identity $ makeReadAction path read }
    makeReadAction path read = ActionBuilder $ do
        -- Ensure rootPattern matches path
        unless (rootPattern ?== path) (fail $ "Bad path: " ++ path)

        return ActionTemplate
            --  TODO tryInner
            { readValue = (validateT <=< hoist liftIO)
                          $   Data.Bifunctor.first errMsg
                          <$> read
            , needs     = Set.singleton path
            }
        where errMsg e = ["Error reading file " <> pack path <> ": " <> e]

-- buildOne with Kleisli Action id a
--   selector :: FilePath -> Kleisli Action id a -> a
--     i.e. 'id -> Action a'
--   we can have 'FilePath -> Action id'... looking it up using the newCache
-- =========> we will need selector to return Action a

-- Retrieve an 'a' back from an 'f a' container, based on a file path
type Selector f = forall a . FilePath -> f a -> Action a

-- | Build one rule under FilePattern, that can handle multiple files according to the selector.
buildOne :: FilePattern -> Selector f -> f (ActionBuilder ()) -> Rules ()
buildOne ptn selector fWrite = ptn %> \outPath -> do
    -- since i know the paths in advance, can i prebuild a 'FilePath -> ActionBuilder ()' ?

    ActionBuilder builder <- selector outPath fWrite
    let ctx = Ctx { ruleName = Just $ T.pack ptn }
    ActionTemplate { readValue, needs } <- runReaderT builder ctx
    need (Set.toList needs)
    -- e <- traced "Writing cache" $ runValidateT . runWriterT $ readValue
    e <- runValidateT . runWriterT $ readValue
    tracedf "Writing cache"
    case e of
        Right ((), finalizer) -> finalizer
        Left err ->
            fail
                $  "Error running shake rule building file "
                <> outPath
                <> " which needs "
                <> show needs
                <> "\nError messages:\n"
                <> formatErrors err


formatErrors :: [Text] -> String
formatErrors errs = TL.unpack $ TL.intercalate "\n" (fmap formatError errs)
  where
    formatError = (" * " <>) . indentFurtherLines . TL.fromStrict
    indentFurtherLines =
        TL.unlines
            . uncurry (++)
            . P.second (fmap ("   " <>))
            . P.splitAt 1
            . TL.lines


pattern BasicBuilder { basicBuilder } =
    Cached1 { cacheBuilder = Identity basicBuilder }

_basicBuilder
    :: Iso
           (Cached1 Identity a)
           (Cached1 Identity b)
           (ActionBuilder a)
           (ActionBuilder b)
_basicBuilder = _Wrapped . _Wrapped

-- TODO used?
funBuilder :: (k -> ActionTemplate a) -> k -> ActionBuilder a
funBuilder f = f >>> ActionBuilder . pure


-- -> | State with Action.
-- toAction :: (Monad m, ca ~ Cached a) => ca -> ShakeStateT m a
-- toAction (CacheFail err)            = pure $ fail $ unpack err
-- toAction c@Cached1 { cacheBuilder } = state (const action &&& (<> cacheRules))
--   where
--     action = do
--         let ActionBuilder builder = runIdentity cacheBuilder
--         result <- builder
--         actionTemplateToAction result


-- withAction :: Monad m => ShakeStateT m a -> (a -> Action b) -> ShakeStateT m b
-- withAction ss f = (>>= f) <$> ss

-- | Run a shake build, returning the result of the given action.
runCached :: (HasCallStack, MonadIO m) => Rules (Cached a) -> m a
runCached rules = do
    result <- liftIO newEmptyMVar
    let rules' = rules >>= action . runAndSaveCached result
    liftIO $ shake options rules'
    liftIO $ readMVar result
  where
    runAndSaveCached result cached =
        runCached cached >>= liftIO . putMVar result
    runCached (Cached1 cacheBuilder) = flip runReaderT defaultCtx $ do
        let ActionBuilder builder = runIdentity cacheBuilder
        result <- builder
        lift $ actionTemplateToAction result
    options = shakeOptions { shakeThreads = 0
                           , shakeReport  = ["build/report.html"]
                           }


-- <*> Internal Functions

type ValidateIO = ValidateT [Text] Action

-- | Copied from 'Control.Monad.Validate.Class' but meant to work more as a hoist for
-- 'ExceptT' rather expecting a 'MonadValidate' inside of it.
exceptToValidateLiftedWith
    :: forall e1 e2 m a
     . (Monad m, Semigroup e2)
    => (e1 -> e2)
    -> ExceptT e1 m a
    -> ValidateT e2 m a
exceptToValidateLiftedWith f = validateT . left f <=< lift . runExceptT
{-# INLINE exceptToValidateLiftedWith #-}

validateT :: MonadValidate e m => Either e a -> m a
validateT = either refute pure
{-# INLINE validateT #-}

-- f (ActionBuilder (t a)) -> ValidateT [Text] (f . ActionBuilder)

-- collect :: Functor f => (a -> g b) -> f a -> g (f b)
--                         ()

-- https://hackage.haskell.org/package/profunctors-5.5.2/docs/Data-Profunctor-Traversing.html#t:Traversing

--  Profunctor p => Traversing (CofreeTraversing p)

-- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
-- wander :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
--  here, s=[a], t=[b],
--    it becomes :: (forall f. Applicative f => (a -> f b) -> [a] -> f [b])


-- this is just fmap!
-- (a -> b) -> (t a -> t b)
-- CF a b -> CF (t a) (t b)


-- flatmapCached
--     :: (Functor f, IsCache c, F c ~ f)
--     => (a -> f b)
--     -> Cached1 f a
--     -> CachedFun a b
--     -> Cached1 h c
-- flatmapCached f cf cg = Cached1 { cacheBuilder = applyCached
--     -- f (ActionBuilder a)
--     -- g (ActionBuilder b)
--     -- h (ActionBuilder c)
--                                , cacheRules   = cacheRules cf <> cacheRules cg
--                                }
--     where
--       -- can I lift function into CachedFun a (g b -> h c)
--           lifted = arr f :: CachedFun a (g b -> h c)


-- | Hoist a 'Cached1' f instance to a 'Cached1' g instance given a
-- natural transformation 'f ~> g'.
-- TODO consider deleting
hoistCached :: (f ~> g) -> (Cached1 f ~> Cached1 g)
hoistCached f Cached1 { cacheBuilder } =
    Cached1 { cacheBuilder = f cacheBuilder }

type (~>) f g = forall x . f x -> g x


-- <*> Cached1 implementation

newtype Cached1 f a =
    Cached1 {
        cacheBuilder :: f (ActionBuilder a) }
    deriving (Functor, Generic)

instance Wrapped (Cached1 f a)
instance Rewrapped (Cached1 f a) (Cached1 f b)

type Cached a = Cached1 Identity a

----------------------------------------------------------------------------

-- | Convenience rmap on the inner Cached of a CachedFun.
cachedFunRmap :: (Cached a1 -> Cached a2) -> CachedFun i a1 -> CachedFun i a2
cachedFunRmap = over (_cachedFunFn . mapped)

newtype CachedFun i a = CachedFun { runCachedFun :: i -> Cached a }
    deriving Functor
    deriving newtype (Semigroup, Monoid)

-- | Lift an IO function to a CachedFun.
cachedFun :: (i -> IO a) -> CachedFun i a
cachedFun f = CachedFun $ fromIO mempty . Identity . f

instance Applicative (CachedFun i) where
    pure = CachedFun . const . pure
    liftA2 op (CachedFun a) (CachedFun b) =
        CachedFun $ \i -> liftA2 op (a i) (b i)

instance Cat.Category CachedFun where
    id = CachedFun pure
    (CachedFun f) . (CachedFun g) = CachedFun
        $ \i -> BasicBuilder $ basicBuilder (g i) >>= (basicBuilder . f)

instance Arrow CachedFun where
    arr f = CachedFun $ pure . f
    (CachedFun ra) *** (CachedFun rb) = CachedFun (foo ra rb)
        where foo a b = a *** b >>> uncurry (liftA2 (,))

instance Profunctor CachedFun where
    lmap f (CachedFun cf) = CachedFun $ cf . f
    rmap = fmap

deriving via Kleisli (Cached1 Identity) instance Choice CachedFun
deriving via Kleisli (Cached1 Identity) instance Strong CachedFun
deriving via Kleisli (Cached1 Identity) instance Traversing CachedFun
deriving via Kleisli (Cached1 Identity) instance ArrowApply CachedFun

-----------------------------------------------------------------------------


-- Extract the builder from a CachedFun as a function.
pattern FunBuilder fb <- (CachedFun (rmap (runIdentity . cacheBuilder) -> fb))

-- | 'CachedFun' as a plain function to 'Cached'.
_cachedFunFn
    :: Iso (CachedFun i a) (CachedFun i b) (i -> Cached a) (i -> Cached b)
_cachedFunFn = iso runCachedFun CachedFun

-- TODO if we drop f from Cached1, this won't matter anymore.
-- | Absorb an external functor over a plain 'Cached' into the 'Cached1'.
absorbF
    :: Functor f
    => Iso
           (f (Cached1 Identity a))
           (f (Cached1 Identity b))
           (Cached1 f a)
           (Cached1 f b)
absorbF = iso (Cached1 . fmap basicBuilder) (fmap BasicBuilder . cacheBuilder)

-- type family Cache (f :: * -> *) a where
--     Cache ((->) k) a = CachedDynFun k a
--     Cache Identity a = Cached1 Identity a

class (Functor (F c)) => IsCache c where
    type F c :: * -> *
    toExternal :: Cached1 (F c) a -> c a
    toInternal :: c a -> Cached1 (F c) a
    internal :: Iso (c a) (c b) (Cached1 (F c) a) (Cached1 (F c) b)
    internal = iso toInternal toExternal
    toInternal = withIso internal const
    toExternal = withIso internal (\ _ y -> y)

instance (Functor f) => IsCache (Cached1 f) where
    type F (Cached1 f) = f
    toInternal = id
    toExternal = id

instance IsCache (CachedFun i) where
    type F (CachedFun i) = (->) i
    internal = _cachedFunFn . absorbF


-- <*> Instances (and their implementation)

instance MonadIO (Cached1 Identity) where
    liftIO = fromIO mempty . Identity

instance (Applicative f) => Applicative (Cached1 f) where
    pure x = Cached1 { cacheBuilder = pure $ pure x }
    liftA2 op fa fb = Cached1
        { cacheBuilder = liftA2 (liftA2 op) (cacheBuilder fa) (cacheBuilder fb)
        }


instance MonadValidate Errs ActionBuilder where
    refute e =
        ActionBuilder
            . pure  --
            $ ActionTemplate { needs = Set.empty, readValue = refute e }
    tolerate = mapBuilderTemplate tolerateInner
        where tolerateInner at = at { readValue = tolerate (readValue at) }

-- Not sure how to derive it in cases other than Identity.
-- Also don't think we need to.
deriving via ActionBuilder instance Monad (Cached1 Identity)
deriving via ActionBuilder instance MonadValidate Errs (Cached1 Identity)

actionTemplateToAction :: ActionTemplate a -> Action a
actionTemplateToAction ActionTemplate { readValue, needs } = do
    need $ Set.toList needs
    (result, finalizer) <-
        either (fail . formatErrors) pure
            =<< (runValidateT . runWriterT $ readValue)
    finalizer
    return result
    --   ioToAction = traced ("Reading result of " ++ show needs)

-- | Context about what is being built.
data Ctx = Ctx
    { ruleName :: Maybe Text
    }
    deriving (Generic, Show, Typeable, Eq, Hashable, NFData, Binary)

defaultCtx = Ctx Nothing

type NormalIO = ExceptT [Text] Action

type ActionBuilder = ActionBuilderT ValidateIO

type CtxAction = ReaderT Ctx Action
newtype ActionBuilderT m a =
    ActionBuilder { actionBuilder :: CtxAction (ActionTemplateT m a) }
    deriving (Functor)

hoistBuilderT :: Monad f => (f ~> g) -> ActionBuilderT f ~> ActionBuilderT g
hoistBuilderT f (ActionBuilder builder) =
    ActionBuilder $ over _readValue (hoist f) <$> builder

-- | Map the 'ActionTemplateT' inside an 'ActionBuilderT'
mapBuilderTemplate
    :: (ActionTemplateT m a -> ActionTemplateT m b)
    -> ActionBuilderT m a
    -> ActionBuilderT m b
mapBuilderTemplate f (ActionBuilder a1) = ActionBuilder $ f <$> a1

type ActionTemplate = ActionTemplateT ValidateIO

-- | The building blocks necessary to produce an 'Action'.
data ActionTemplateT mt a = ActionTemplate
    { readValue :: WithFinalizer mt a
    , needs     :: Set FilePath
    }
    deriving Functor

type WithFinalizer = WriterT (Action ())

-- _writer :: m ~> n -> Lens (WriterT w m a) (WriterT w n b) (m a) (n b)
-- _writer f = lens
--     (fmap fst . runWriterT)
--     (\w b -> mapWriterT (liftA2 (\b a -> a & _1 .~ b) b . f) w)

_readValue
    :: Lens
           (ActionTemplateT f a)
           (ActionTemplateT g b)
           (WriterT (Action ()) f a)
           (WriterT (Action ()) g b)
_readValue = lens readValue (\template b -> template { readValue = b })

instance Applicative mt => Applicative (ActionTemplateT mt) where
    pure x = ActionTemplate { readValue = pure x, needs = Set.empty }
    liftA2 op fa fb = ActionTemplate
        { readValue = liftA2 op (readValue fa) (readValue fb)
        , needs     = needs fa <> needs fb
        }

instance (Semigroup a, Applicative mt) => Semigroup (ActionTemplateT mt a) where
    a <> b = liftA2 (<>) a b

instance Applicative m => Applicative (ActionBuilderT m) where
    pure x = ActionBuilder (pure . pure $ x)
    liftA2 op (ActionBuilder fa) (ActionBuilder fb) =
        ActionBuilder $ (liftA2 . liftA2 $ op) fa fb

instance Monad ActionBuilder where
    (ActionBuilder ma) >>= famb = ActionBuilder $ do
        actionTemplate <- ma
        -- traced
        --     (formatToString ("ActionTemplate: " % shown) (needs actionTemplate))
        --     (pure ())

        value          <- lift $ actionTemplateToAction actionTemplate
            -- don't know how to expose the 'either' so
            -- dealing with it inside the Action
        let ActionBuilder mb = famb value
        mb

instance (Monoid a, Applicative f) => Monoid (Cached1 f a) where
    mempty = pure mempty

instance (Semigroup a, Applicative f) => Semigroup (Cached1 f a) where
    a <> b = Cached1
        { cacheBuilder = liftA2 combineBuilders
                                (cacheBuilder a)
                                (cacheBuilder b)
        }
      where
        combineBuilders (ActionBuilder a) (ActionBuilder b) =
            ActionBuilder $ liftA2 (<>) a b

And Prelouder.hs

```haskell module Prelouder ( module Exports , fprintln , makeGettable , print , putStr , putStrLn ) where

-- Exports

import Prelude as Exports
hiding ( fail
, print
, putStr
, putStrLn
, readFile
, uncons
, writeFile
)

import Control.Applicative as Exports
import Control.Arrow as Exports
import Control.Exception.Safe as Exports
import Control.Lens as Exports
hiding ( (<.>)
, element
)
import Control.Lens.Operators as Exports
hiding ( (<.>) )
import Control.Monad as Exports
hiding ( fail )
import Control.Monad.Extra as Exports
( whenJust )
import Control.Monad.Fail as Exports
( MonadFail(..) )
import Control.Monad.IO.Class as Exports
import Control.Monad.Trans.Except as Exports
( Except
, ExceptT(ExceptT)
, except
, mapExcept
, mapExceptT
, runExcept
, runExceptT
, withExcept
, withExceptT
)
import Data.Bool as Exports
import Data.Either as Exports
import Data.Foldable as Exports
import Data.Functor as Exports
import Data.Hashable as Exports
import Data.Int as Exports
import Data.List as Exports
hiding ( uncons )
import Data.Maybe as Exports
import Data.Monoid as Exports
import Data.Scientific as Exports
( Scientific )
import qualified Data.Scientific as Exports.Sci
import Data.String as Exports
import Data.Text as Exports
( Text
, pack
, unpack
)
import qualified Data.Text.Lazy
import Data.Traversable as Exports
import Data.Tuple as Exports
import GHC.Generics as Exports
( Generic )
import System.Directory as Exports
import System.FilePath as Exports
import Text.Printf as Exports

-- Trialling formatting library
import Formatting as Exports
hiding ( left
, right
)
import Formatting.Formatters as Exports
( commas
, fixed
, ords
, plural
, sci
, shortest
, shown
, stext
, string
)

-- Aeson re-exports

import Data.Aeson as Exports
hiding ( (.=) )
import Data.Aeson.Types as Exports
( (.:)
, (.:?)
, FromJSON(..)
, ToJSON(..)
, Value(..)
, withArray
, withObject
)

-- Internal

import qualified Data.Text.IO
import qualified Data.Text.Lazy.Builder as T
import qualified Data.Text.Lazy.IO as T
import qualified Prelude as P
hiding ( fail )

-- Some lens stuff

makeGettable = makeLensesWith (lensRules & generateUpdateableOptics .~ False)

-- IO

putStr :: MonadIO m => Text -> m ()
putStr = liftIO . Data.Text.IO.putStr

putStrLn :: MonadIO m => Text -> m ()
putStrLn = liftIO . Data.Text.IO.putStrLn

print :: (MonadIO m, Show a) => a -> m ()
print = liftIO . P.print

fprintln :: MonadIO m => Format (m ()) a -> a
fprintln m = runFormat m (liftIO . T.putStrLn . T.toLazyText)

</details>

### Expected behaviour
HLS should at least continue working on other files, even if this one file encountered a problem

### Actual behaviour
HLS stops working altogether (though doesn't crash), stuck either on "Indexing (0/1)" or "Processing (some number/total number)" in the statusbar.
I think it gets stuck on "Indexing" if I try to jump to a symbol in the file.
Type information doesn't work anymore, neither does navigating to symbols inside the file.

The only error I can find in the VS Code output is this:

haskell-language-server-8.10.4: Maybe.fromJust: Nothing
CallStack (from HasCallStack):
error, called at libraries/base/Data/Maybe.hs:148:21 in base:Data.Maybe
fromJust, called at src/Development/IDE/Plugin/TypeLenses.hs:283:18 in ghcide-1.4.0.0-inplace:Development.IDE.Plugin.TypeLenses

And sure enough, when i disabled type lenses in the config, the problem went away.

### Include debug information
Execute in the root of your project the command `haskell-language-server --debug .` and paste the logs here:

<details>
<summary>
Debug output: (didn't provide the whole thing at this time, contains too much information about project files)
However, I copied some errors that might be relevant.
</summary>

2021-07-06 00:29:19.740563 [ThreadId 1293] INFO hls: File: /Users/admin/code/deep-value/Setup.hs
Hidden: no
Range: 1:8-1:27
Source: not found
Severity: DsError
Message:
Could not load module ‘Distribution.Simple’
It is a member of the hidden package ‘Cabal-3.2.1.0’.
You can run ‘:set -package Cabal’ to expose it.
(Note: this unloads all the modules in the current scope.)

...

2021-07-06 00:29:23.878926 [ThreadId 2106] INFO hls: finish: GetHie (took 0.03s)
Files that failed:

• /Users/admin/code/deep-value/Setup.hs
  2021-07-06 00:29:23.879824 [ThreadId 2107] INFO hls: finish: GenerateCore (took 0.00s)
• /Users/admin/code/deep-value/test/Spec.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/Setup.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/lib/AlphaVantage/Client.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/lib/AlphaVantage/Core.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/lib/AlphaVantage/Logging.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/tests/ApproxEq.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/tests/Instances.hs
• /Users/admin/code/deep-value/vendor/alpha-vantage/tests/Test.hs

Completed (43 files worked, 9 files failed)
haskell-language-server-wrapper: callProcess: /Users/admin/.ghcup/bin/haskell-language-server-8.10.4 "--debug" "." (exit 9): failed

</details>

Paste the logs from the lsp-client, e.g. for [VS Code](https://github.com/haskell/vscode-haskell#troubleshooting)

<details>
<summary>
LSP logs:
</summary>

[client] run command: "haskell-language-server-wrapper --lsp"
[client] debug command: "haskell-language-server-wrapper --lsp"
[client] server cwd: undefined
Found "/Users/admin/code/deep-value/hie.yaml" for "/Users/admin/code/deep-value/a"
Run entered for haskell-language-server-wrapper(haskell-language-server-wrapper) Version 1.2.0.0, Git revision 8cfe8b2 (dirty) x86_64 ghc-8.10.4
Current directory: /Users/admin/code/deep-value
Operating system: darwin
Arguments: ["--lsp"]
Cradle directory: /Users/admin/code/deep-value
Cradle type: Stack

Tool versions found on the $PATH
cabal: 3.4.0.0
stack: 2.5.1.1
ghc: Not found

Consulting the cradle to get project GHC version...
Project GHC version: 8.10.4
haskell-language-server exe candidates: ["haskell-language-server-8.10.4","haskell-language-server"]
Launching haskell-language-server exe at:/Users/admin/.ghcup/bin/haskell-language-server-8.10.4
haskell-language-server version: 1.2.0.0 (GHC: 8.10.4) (PATH: /Users/admin/.ghcup/bin/haskell-language-server-8.10.4~1.2.0) (GIT hash: 8cfe8b2)
Starting (haskell-language-server)LSP server...
with arguments: GhcideArguments {argsCommand = LSP, argsCwd = Nothing, argsShakeProfiling = Nothing, argsTesting = False, argsExamplePlugin = False, argsDebugOn = False, argsLogFile = Nothing, argsThreads = 0, argsProjectGhcVersion = False}
with plugins: [PluginId "pragmas",PluginId "floskell",PluginId "fourmolu",PluginId "tactics",PluginId "ormolu",PluginId "stylish-haskell",PluginId "retrie",PluginId "brittany",PluginId "class",PluginId "haddockComments",PluginId "eval",PluginId "importLens",PluginId "refineImports",PluginId "moduleName",PluginId "hlint",PluginId "splice",PluginId "ghcide-hover-and-symbols",PluginId "ghcide-code-actions-imports-exports",PluginId "ghcide-code-actions-type-signatures",PluginId "ghcide-code-actions-bindings",PluginId "ghcide-code-actions-fill-holes",PluginId "ghcide-completions",PluginId "ghcide-type-lenses",PluginId "ghcide-core"]
in directory: /Users/admin/code/deep-value
Starting LSP server...
If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!
Started LSP server in 0.00s
setInitialDynFlags cradle: Cradle {cradleRootDir = "/Users/admin/code/deep-value", cradleOptsProg = CradleAction: Stack}
2021-07-06 00:21:58.947494 [ThreadId 5] INFO hls: Registering ide configuration: IdeConfiguration {workspaceFolders = fromList [NormalizedUri (-4486092460564443533) "file:///Users/admin/code/deep-value"], clientSettings = hashed Nothing}
2021-07-06 00:21:58.962617 [ThreadId 106] INFO hls: Consulting the cradle for "src/Build.hs"
Output from setting up the cradle Cradle {cradleRootDir = "/Users/admin/code/deep-value", cradleOptsProg = CradleAction: Stack}

Using main module: 1. Package `deep-value' component deep-value:exe:deep-value-exe with main-is file: /Users/admin/code/deep-value/app/Main.hs
deep-value> configure (lib + exe)
Configuring deep-value-0.1.0.0...
deep-value> initial-build-steps (lib + exe)
The following GHC options are incompatible with GHCi and have not been passed to it: -threaded
Configuring GHCi with the following packages: deep-value

---

Warning: Multiple files use the same module name:
* Paths_deep_value found at the following paths
* /Users/admin/code/deep-value/.stack-work/dist/x86_64-osx/Cabal-3.2.1.0/build/autogen/Paths_deep_value.hs (deep-value:lib)
* /Users/admin/code/deep-value/.stack-work/dist/x86_64-osx/Cabal-3.2.1.0/build/deep-value-exe/autogen/Paths_deep_value.hs (deep-value:exe:deep-value-exe)

---

/Users/admin/code/deep-value/.stack-work/install/x86_64-osx/40e27d4c15c8fd7f27200406d8f9640e41bd5c7e9d249829c227bc2bdb997679/8.10.4/pkgdb:/Users/admin/.stack/snapshots/x86_64-osx/40e27d4c15c8fd7f27200406d8f9640e41bd5c7e9d249829c227bc2bdb997679/8.10.4/pkgdb:/Users/admin/.ghcup/ghc/8.10.4/lib/ghc-8.10.4/package.conf.d
2021-07-06 00:22:03.515543 [ThreadId 106] INFO hls: Using interface files cache dir: /Users/admin/.cache/ghcide/main-86119f96a9a584674b3197871e898ec8fd1b25e7
2021-07-06 00:22:03.517732 [ThreadId 106] INFO hls: Making new HscEnv[main]
2021-07-06 00:22:03.738924 [ThreadId 359] INFO hls: finish: ModuleName.ghcSession (took 0.03s)
2021-07-06 00:22:03.739501 [ThreadId 359] INFO hls: finish: ModuleName.ghcSession (took 0.03s)
2021-07-06 00:22:03.775739 [ThreadId 359] INFO hls: finish: Wingman.getIdeDynflags.GetModSummaryWithoutTimestamps (took 0.06s)
2021-07-06 00:22:03.842936 [ThreadId 184] INFO hls: finish: importLens (took 0.13s)
2021-07-06 00:22:03.843164 [ThreadId 184] INFO hls: finish: GhcideCodeActions.getParsedModule (took 0.13s)
2021-07-06 00:22:03.844101 [ThreadId 364] INFO hls: finish: ModuleName.GetParsedModule (took 0.10s)
2021-07-06 00:22:03.844194 [ThreadId 364] INFO hls: finish: RefineImports (took 0.13s)
2021-07-06 00:22:03.844254 [ThreadId 364] INFO hls: finish: Pragmas.GetParsedModule (took 0.13s)
2021-07-06 00:22:03.84434 [ThreadId 364] INFO hls: finish: splice.codeAction.GitHieAst (took 0.13s)
2021-07-06 00:22:03.844436 [ThreadId 364] INFO hls: finish: Outline (took 0.13s)
2021-07-06 00:22:03.847102 [ThreadId 363] INFO hls: finish: parsed (took 0.14s)
2021-07-06 00:22:03.849406 [ThreadId 364] INFO hls: finish: Pragmas.GetFileContents (took 0.00s)
2021-07-06 00:22:03.859668 [ThreadId 363] INFO hls: finish: HaddockComments.GetAnnotatedParsedSource (took 0.15s)
2021-07-06 00:22:03.859881 [ThreadId 363] INFO hls: finish: Wingman.codeLensProvider.GetAnnotatedParsedSource (took 0.08s)
2021-07-06 00:22:03.863376 [ThreadId 363] INFO hls: finish: Wingman.getIdeDynflags.GetModSummaryWithoutTimestamps (took 0.15s)
2021-07-06 00:22:03.877267 [ThreadId 357] INFO hls: finish: Outline (took 0.17s)
2021-07-06 00:22:03.881928 [ThreadId 364] INFO hls: finish: ModuleName.GetParsedModule (took 0.14s)
2021-07-06 00:22:03.882292 [ThreadId 363] INFO hls: finish: parsed (took 0.17s)
2021-07-06 00:22:03.88263 [ThreadId 364] INFO hls: finish: Wingman.codeLensProvider.GetAnnotatedParsedSource (took 0.02s)
2021-07-06 00:22:05.231985 [ThreadId 949] INFO hls: finish: retrie (took 1.52s)
2021-07-06 00:22:05.231866 [ThreadId 950] INFO hls: finish: codeLens.TypeCheck (took 1.52s)
2021-07-06 00:22:05.235941 [ThreadId 951] INFO hls: finish: (took 1.52s)
2021-07-06 00:22:05.302827 [ThreadId 978] INFO hls: finish: Pragmas.GetParsedModule (took 0.00s)
2021-07-06 00:22:05.303136 [ThreadId 978] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:05.303258 [ThreadId 978] INFO hls: finish: Pragmas.GetFileContents (took 0.00s)
2021-07-06 00:22:05.303382 [ThreadId 978] INFO hls: finish: retrie (took 0.00s)
2021-07-06 00:22:05.303371 [ThreadId 979] INFO hls: finish: HaddockComments.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:05.303519 [ThreadId 979] INFO hls: finish: importLens (took 0.00s)
2021-07-06 00:22:05.303599 [ThreadId 979] INFO hls: finish: splice.codeAction.GitHieAst (took 0.00s)
2021-07-06 00:22:05.303649 [ThreadId 978] INFO hls: finish: GhcideCodeActions.getParsedModule (took 0.00s)
2021-07-06 00:22:05.76144 [ThreadId 787] INFO hls: finish: Wingman.judgementForHole.GetHieAst (took 0.46s)
2021-07-06 00:22:05.761653 [ThreadId 992] INFO hls: finish: Wingman.codeLensProvider.GetBindings (took 1.90s)
2021-07-06 00:22:05.761736 [ThreadId 787] INFO hls: finish: codeLens.GetBindings (took 0.53s)
2021-07-06 00:22:05.761623 [ThreadId 991] INFO hls: finish: Wingman.judgementForHole.GetHieAst (took 2.05s)
2021-07-06 00:22:05.76191 [ThreadId 979] INFO hls: finish: Wingman.emptyCaseScrutinees.TypeCheck (took 0.00s)
2021-07-06 00:22:05.76218 [ThreadId 991] INFO hls: finish: Wingman.emptyCaseScrutinees.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:05.762107 [ThreadId 992] INFO hls: finish: Wingman.judgementForHole.GetBindings (took 0.00s)
2021-07-06 00:22:05.762386 [ThreadId 787] INFO hls: finish: Wingman.judgementForHole.TypeCheck (took 0.00s)
2021-07-06 00:22:05.762396 [ThreadId 991] INFO hls: finish: Wingman.judgementForHole.GetBindings (took 0.00s)
2021-07-06 00:22:05.762713 [ThreadId 991] INFO hls: finish: Wingman.judgementForHole.TypeCheck (took 0.00s)
2021-07-06 00:22:05.763266 [ThreadId 787] INFO hls: finish: Wingman.judgementForHole.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:05.763176 [ThreadId 991] INFO hls: finish: Wingman.judgementForHole.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:05.764973 [ThreadId 995] INFO hls: finish: codeLens.GetGlobalBindingTypeSigs (took 0.00s)
2021-07-06 00:22:06.090081 [ThreadId 979] INFO hls: finish: Pragmas.GetParsedModule (took 0.00s)
2021-07-06 00:22:06.090561 [ThreadId 979] INFO hls: finish: HaddockComments.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:06.090688 [ThreadId 979] INFO hls: finish: GhcideCodeActions.getParsedModule (took 0.00s)
2021-07-06 00:22:06.090772 [ThreadId 979] INFO hls: finish: importLens (took 0.00s)
2021-07-06 00:22:06.090831 [ThreadId 979] INFO hls: finish: splice.codeAction.GitHieAst (took 0.00s)
2021-07-06 00:22:06.090935 [ThreadId 979] INFO hls: finish: retrie (took 0.00s)
2021-07-06 00:22:06.091001 [ThreadId 979] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:06.091083 [ThreadId 979] INFO hls: finish: Pragmas.GetFileContents (took 0.00s)
2021-07-06 00:22:06.09115 [ThreadId 979] INFO hls: finish: Wingman.judgementForHole.GetHieAst (took 0.00s)
2021-07-06 00:22:06.399976 [ThreadId 960] INFO hls: finish: Wingman.judgementForHole.GetBindings (took 0.00s)
2021-07-06 00:22:06.400434 [ThreadId 979] INFO hls: finish: Wingman.judgementForHole.TypeCheck (took 0.00s)
2021-07-06 00:22:06.406812 [ThreadId 979] INFO hls: finish: RefineImports (took 2.70s)
2021-07-06 00:22:06.469941 [ThreadId 1012] INFO hls: finish: Wingman.judgementForHole.GhcSessionDeps (took 0.00s)
haskell-language-server-8.10.4: Maybe.fromJust: Nothing
CallStack (from HasCallStack):
error, called at libraries/base/Data/Maybe.hs:148:21 in base:Data.Maybe
fromJust, called at src/Development/IDE/Plugin/TypeLenses.hs:283:18 in ghcide-1.4.0.0-inplace:Development.IDE.Plugin.TypeLenses
2021-07-06 00:22:07.141428 [ThreadId 1195] INFO hls: finish: codeLens.TypeCheck (took 3.43s)
2021-07-06 00:22:07.141742 [ThreadId 1203] INFO hls: finish: (took 3.43s)
2021-07-06 00:22:07.146623 [ThreadId 1222] INFO hls: finish: codeLens.GetBindings (took 0.01s)
2021-07-06 00:22:07.146755 [ThreadId 1221] INFO hls: finish: Wingman.codeLensProvider.GetBindings (took 3.26s)
2021-07-06 00:22:07.147095 [ThreadId 1225] INFO hls: finish: Wingman.emptyCaseScrutinees.TypeCheck (took 0.00s)
2021-07-06 00:22:07.147366 [ThreadId 1228] INFO hls: finish: codeLens.GetGlobalBindingTypeSigs (took 0.00s)
2021-07-06 00:22:07.147582 [ThreadId 1227] INFO hls: finish: Wingman.emptyCaseScrutinees.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:07.614825 [ThreadId 1507] INFO hls: finish: RefineImports (took 3.90s)
2021-07-06 00:22:09.805366 [ThreadId 1524] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:22:09.891968 [ThreadId 1541] INFO hls: finish: codeLens.TypeCheck (took 0.00s)
2021-07-06 00:22:09.892048 [ThreadId 1543] INFO hls: finish: parsed (took 0.00s)
2021-07-06 00:22:09.892111 [ThreadId 1545] INFO hls: finish: (took 0.00s)
2021-07-06 00:22:09.892153 [ThreadId 1553] INFO hls: finish: codeLens.GetBindings (took 0.00s)
2021-07-06 00:22:09.892175 [ThreadId 1547] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:09.892225 [ThreadId 1551] INFO hls: finish: ModuleName.ghcSession (took 0.00s)
2021-07-06 00:22:09.892234 [ThreadId 1549] INFO hls: finish: Wingman.getIdeDynflags.GetModSummaryWithoutTimestamps (took 0.00s)
2021-07-06 00:22:09.892281 [ThreadId 1554] INFO hls: finish: codeLens.GetGlobalBindingTypeSigs (took 0.00s)
2021-07-06 00:22:09.892348 [ThreadId 1556] INFO hls: finish: Wingman.codeLensProvider.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:09.892559 [ThreadId 1558] INFO hls: finish: Wingman.codeLensProvider.GetBindings (took 0.00s)
2021-07-06 00:22:09.892701 [ThreadId 1560] INFO hls: finish: Wingman.emptyCaseScrutinees.TypeCheck (took 0.00s)
2021-07-06 00:22:09.89277 [ThreadId 1562] INFO hls: finish: Wingman.emptyCaseScrutinees.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:09.892922 [ThreadId 1564] INFO hls: finish: ModuleName.GetParsedModule (took 0.00s)
2021-07-06 00:22:13.408743 [ThreadId 1582] INFO hls: finish: codeLens.TypeCheck (took 0.00s)
2021-07-06 00:22:13.408914 [ThreadId 1588] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:13.408964 [ThreadId 1584] INFO hls: finish: parsed (took 0.00s)
2021-07-06 00:22:13.408822 [ThreadId 1586] INFO hls: finish: Wingman.getIdeDynflags.GetModSummaryWithoutTimestamps (took 0.00s)
2021-07-06 00:22:13.409071 [ThreadId 1594] INFO hls: finish: codeLens.GetBindings (took 0.00s)
2021-07-06 00:22:13.409123 [ThreadId 1592] INFO hls: finish: ModuleName.ghcSession (took 0.00s)
2021-07-06 00:22:13.40914 [ThreadId 1582] INFO hls: finish: Wingman.codeLensProvider.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:13.409054 [ThreadId 1590] INFO hls: finish: (took 0.00s)
2021-07-06 00:22:13.409209 [ThreadId 1595] INFO hls: finish: codeLens.GetGlobalBindingTypeSigs (took 0.00s)
2021-07-06 00:22:13.409339 [ThreadId 1597] INFO hls: finish: Wingman.codeLensProvider.GetBindings (took 0.00s)
2021-07-06 00:22:13.409558 [ThreadId 1599] INFO hls: finish: Wingman.emptyCaseScrutinees.TypeCheck (took 0.00s)
2021-07-06 00:22:13.409683 [ThreadId 1601] INFO hls: finish: Wingman.emptyCaseScrutinees.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:13.410523 [ThreadId 1603] INFO hls: finish: ModuleName.GetParsedModule (took 0.00s)
2021-07-06 00:22:13.411801 [ThreadId 1615] INFO hls: finish: Pragmas.GetParsedModule (took 0.00s)
2021-07-06 00:22:13.411741 [ThreadId 1617] INFO hls: finish: HaddockComments.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:13.411935 [ThreadId 1625] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:13.412122 [ThreadId 1627] INFO hls: finish: retrie (took 0.00s)
2021-07-06 00:22:13.412212 [ThreadId 1633] INFO hls: finish: importLens (took 0.00s)
2021-07-06 00:22:13.412216 [ThreadId 1629] INFO hls: finish: Wingman.judgementForHole.GetHieAst (took 0.00s)
2021-07-06 00:22:13.413312 [ThreadId 1631] INFO hls: finish: GhcideCodeActions.getParsedModule (took 0.00s)
2021-07-06 00:22:13.413298 [ThreadId 1635] INFO hls: finish: Pragmas.GetFileContents (took 0.00s)
2021-07-06 00:22:13.41326 [ThreadId 1637] INFO hls: finish: splice.codeAction.GitHieAst (took 0.00s)
2021-07-06 00:22:13.41345 [ThreadId 1643] INFO hls: finish: Wingman.judgementForHole.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:13.413442 [ThreadId 1641] INFO hls: finish: Wingman.judgementForHole.TypeCheck (took 0.00s)
2021-07-06 00:22:13.413376 [ThreadId 1639] INFO hls: finish: Wingman.judgementForHole.GetBindings (took 0.00s)
2021-07-06 00:22:14.986376 [ThreadId 1785] INFO hls: finish: importLens (took 0.01s)
2021-07-06 00:22:14.986364 [ThreadId 1789] INFO hls: finish: RefineImports (took 0.01s)
2021-07-06 00:22:14.986482 [ThreadId 1770] INFO hls: finish: Outline (took 0.01s)
2021-07-06 00:22:14.986538 [ThreadId 1785] INFO hls: finish: splice.codeAction.GitHieAst (took 0.01s)
2021-07-06 00:22:14.986611 [ThreadId 1788] INFO hls: finish: Pragmas.GetParsedModule (took 0.01s)
2021-07-06 00:22:14.986528 [ThreadId 1790] INFO hls: finish: GhcideCodeActions.getParsedModule (took 0.01s)
2021-07-06 00:22:14.98777 [ThreadId 1789] INFO hls: finish: Pragmas.GetFileContents (took 0.00s)
2021-07-06 00:22:14.988952 [ThreadId 1802] INFO hls: finish: HaddockComments.GetAnnotatedParsedSource (took 0.01s)
2021-07-06 00:22:15.041862 [ThreadId 2746] INFO hls: finish: retrie (took 0.06s)
2021-07-06 00:22:15.05011 [ThreadId 2794] INFO hls: finish: Wingman.judgementForHole.GetHieAst (took 0.07s)
2021-07-06 00:22:15.050989 [ThreadId 2799] INFO hls: finish: Wingman.judgementForHole.GetBindings (took 0.00s)
2021-07-06 00:22:15.051143 [ThreadId 2800] INFO hls: finish: Wingman.judgementForHole.TypeCheck (took 0.00s)
2021-07-06 00:22:15.051598 [ThreadId 2802] INFO hls: finish: Wingman.judgementForHole.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:15.189901 [ThreadId 2816] INFO hls: finish: codeLens.TypeCheck (took 0.00s)
2021-07-06 00:22:15.18998 [ThreadId 2820] INFO hls: finish: Wingman.getIdeDynflags.GetModSummaryWithoutTimestamps (took 0.00s)
2021-07-06 00:22:15.189993 [ThreadId 2818] INFO hls: finish: parsed (took 0.00s)
2021-07-06 00:22:15.190099 [ThreadId 2824] INFO hls: finish: ModuleName.ghcSession (took 0.00s)
2021-07-06 00:22:15.190214 [ThreadId 2829] INFO hls: finish: codeLens.GetBindings (took 0.00s)
2021-07-06 00:22:15.190269 [ThreadId 2831] INFO hls: finish: Wingman.codeLensProvider.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:15.190433 [ThreadId 2837] INFO hls: finish: Wingman.codeLensProvider.GetBindings (took 0.00s)
2021-07-06 00:22:15.190553 [ThreadId 2841] INFO hls: finish: Wingman.emptyCaseScrutinees.TypeCheck (took 0.00s)
2021-07-06 00:22:15.190769 [ThreadId 2844] INFO hls: finish: Wingman.emptyCaseScrutinees.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:15.190931 [ThreadId 2852] INFO hls: finish: codeLens.GetGlobalBindingTypeSigs (took 0.00s)
2021-07-06 00:22:15.19101 [ThreadId 2855] INFO hls: finish: (took 0.00s)
2021-07-06 00:22:15.191122 [ThreadId 2856] INFO hls: finish: ModuleName.GetParsedModule (took 0.00s)
2021-07-06 00:22:15.192545 [ThreadId 2911] INFO hls: finish: importLens (took 0.00s)
2021-07-06 00:22:15.192558 [ThreadId 2908] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:15.192619 [ThreadId 2913] INFO hls: finish: Wingman.judgementForHole.GetHieAst (took 0.00s)
2021-07-06 00:22:15.192675 [ThreadId 2906] INFO hls: finish: HaddockComments.GetAnnotatedParsedSource (took 0.00s)
2021-07-06 00:22:15.192702 [ThreadId 2904] INFO hls: finish: Pragmas.GetParsedModule (took 0.00s)
2021-07-06 00:22:15.192731 [ThreadId 2915] INFO hls: finish: retrie (took 0.00s)
2021-07-06 00:22:15.192937 [ThreadId 2913] INFO hls: finish: GhcideCodeActions.getParsedModule (took 0.00s)
2021-07-06 00:22:15.193063 [ThreadId 2921] INFO hls: finish: Wingman.judgementForHole.GetBindings (took 0.00s)
2021-07-06 00:22:15.193147 [ThreadId 2925] INFO hls: finish: splice.codeAction.GitHieAst (took 0.00s)
2021-07-06 00:22:15.193288 [ThreadId 2928] INFO hls: finish: Pragmas.GetFileContents (took 0.00s)
2021-07-06 00:22:15.193432 [ThreadId 2932] INFO hls: finish: Wingman.judgementForHole.TypeCheck (took 0.00s)
2021-07-06 00:22:15.193505 [ThreadId 2937] INFO hls: finish: Wingman.judgementForHole.GhcSessionDeps (took 0.00s)
2021-07-06 00:22:15.194619 [ThreadId 2967] INFO hls: finish: RefineImports (took 0.00s)
2021-07-06 00:22:19.321146 [ThreadId 2976] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:22:19.520169 [ThreadId 2991] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:22:19.924615 [ThreadId 3003] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:23:00.252475 [ThreadId 3015] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:30:48.993568 [ThreadId 3041] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:30:50.454582 [ThreadId 3055] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:31:40.076535 [ThreadId 3067] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)
2021-07-06 00:33:22.01285 [ThreadId 3077] INFO hls: finish: Wingman.getMetaprogramsAtSpan.TypeCheck (took 0.00s)

</details>

[peterwicksstringfield]

This looks like #1951 and #1975, where the type-lens plugin doesn't handle certain pattern synonyms correctly. This is fixed, but the fix isn't in 1.2.0. Should be in the next release.

As a work around, you can add explicit type signatures to the pattern synonyms, or disable the type-lens plugin.

pattern FunBuilder :: (a1 -> ActionBuilder a2) -> CachedFun a1 a2
pattern BasicBuilder :: ActionBuilder a -> Cached1 Identity a

(I generated those type signatures using the type-lens plugin from a trunk build of hls.)

Excerpt from the log above:

haskell-language-server-8.10.4: Maybe.fromJust: Nothing
CallStack (from HasCallStack):
error, called at libraries/base/Data/Maybe.hs:148:21 in base:Data.Maybe
fromJust, called at src/Development/IDE/Plugin/TypeLenses.hs:283:18 in ghcide-1.4.0.0-inplace:Development.IDE.Plugin.TypeLenses

[jneira]

Closing optimistically as 1.3.0 has been released, @dansanduleac feel free to reopen if you continue experiencing the bug with 1.3.0

[dansanduleac]

Thanks @jneira, can confirm it works fine now.