ListInstances.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE ImportQualifiedPost    #-}

import Protolude

import Control.Concurrent.STM (newTVarIO)
import "monad-logger" Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Data.IORef (newIORef)
import Data.Map qualified as Map
import Language.PureScript.Ide (handleCommand)
import Language.PureScript.Ide.Command (Command(..))
import Language.PureScript.Ide.Error (IdeError)
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util (identT, properNameT)
import Language.PureScript.Ide.State qualified as State
import Lens.Micro ((^.))
import Lens.Micro.Extras (preview)
import System.Directory (setCurrentDirectory)

import Language.PureScript qualified as P

defConfig :: IdeConfiguration
defConfig =
  IdeConfiguration
    { confLogLevel = LogNone
    , confOutputPath = "output/"
    , confGlobs = []
    }

mn :: Text -> P.ModuleName
mn = P.moduleNameFromString

runIde ::
  IdeConfiguration ->
  ExceptT IdeError (ReaderT IdeEnvironment (NoLoggingT IO)) a ->
  IO (Either IdeError a)
runIde conf f = do
  stateVar <- newTVarIO emptyIdeState
  ts <- newIORef Nothing
  let env' = IdeEnvironment {ideStateVar = stateVar, ideConfiguration = conf, ideCacheDbTimestamp = ts}
  runNoLoggingT (runReaderT (runExceptT f) env')

listInstances :: FilePath -> IO ()
listInstances path = do
  setCurrentDirectory path
  modules' <- runIde defConfig do
    _ <- handleCommand (LoadSync [])
    State.getAllModules Nothing
  case modules' of
    Left err -> panic ("Failed to load with: " <> show err)
    Right modules ->
      let (Just preludeDecls) = Map.lookup (mn "Prelude") modules in
      let classes = mapMaybe (preview (idaDeclaration . _IdeDeclTypeClass)) preludeDecls in
      for_ classes \cls -> do
        putStrLn (cls ^. ideTCName . properNameT)
        for_ (cls ^. ideTCInstances) \inst ->
          putStrLn ("  " <> (inst ^. ideInstanceName . identT))

output

> listInstances "C:/Users/creek/code/tmp"
Applicative
  applicativeFn
  applicativeArray
  applicativeProxy
  applicativeAdditive
  applicativeConj
  applicativeDisj
  applicativeDual
  applicativeMultiplicative
  applicativeFirst
  applicativeLast
  applicativeEffect
Apply
  applyFn
  applyArray
  applyProxy
  applyAdditive
  applyConj
  applyDisj
  applyDual
  applyMultiplicative
  applyFirst
  applyLast
  applyEffect
Bind
  bindFn
  bindArray
  bindProxy
  bindAdditive
  bindConj
  bindDisj
  bindDual
  bindMultiplicative
  bindFirst
  bindLast
  bindEffect
BooleanAlgebra
  booleanAlgebraBoolean
  booleanAlgebraUnit
  booleanAlgebraFn
  booleanAlgebraRecord
  booleanAlgebraProxy
  booleanAlgebraProxy2
  booleanAlgebraProxy3
Bounded
  boundedBoolean
  boundedInt
  boundedChar
  boundedOrdering
  boundedUnit
  boundedNumber
  boundedProxy
  boundedProxy2
  boundedProxy3
  boundedRecord
  boundedAdditive
  boundedConj
  boundedDisj
  boundedDual
  boundedEndo
  boundedMultiplicative
  boundedFirst
  boundedLast
Category
  categoryFn
CommutativeRing
  commutativeRingInt
  commutativeRingNumber
  commutativeRingUnit
  commutativeRingFn
  commutativeRingRecord
  commutativeRingProxy
  commutativeRingProxy2
  commutativeRingProxy3
Discard
  discardUnit
  discardProxy
  discardProxy2
  discardProxy3
DivisionRing
  divisionringNumber
Eq
  eqBoolean
  eqInt
  eqNumber
  eqChar
  eqString
  eqUnit
  eqVoid
  eqArray
  eqRec
  eqProxy
  eqProxy2
  eqProxy3
  eqAdditive
  eqConj
  eqDisj
  eqDual
  eqEndo
  eqMultiplicative
  eqOrdering
  eqFirst
  eqLast
EuclideanRing
  euclideanRingInt
  euclideanRingNumber
Field
  field
Functor
  functorFn
  functorArray
  functorProxy
  functorAdditive
  functorConj
  functorDisj
  functorDual
  functorMultiplicative
  functorFirst
  functorLast
  functorEffect
HeytingAlgebra
  heytingAlgebraBoolean
  heytingAlgebraUnit
  heytingAlgebraFunction
  heytingAlgebraProxy
  heytingAlgebraProxy2
  heytingAlgebraProxy3
  heytingAlgebraRecord
Monad
  monadFn
  monadArray
  monadProxy
  monadAdditive
  monadConj
  monadDisj
  monadDual
  monadMultiplicative
  monadFirst
  monadLast
  monadEffect
Monoid
  monoidUnit
  monoidOrdering
  monoidFn
  monoidString
  monoidArray
  monoidRecord
  monoidAdditive
  monoidConj
  monoidDisj
  monoidDual
  monoidEndo
  monoidMultiplicative
  monoidEffect
  monoidEffectFn1
  monoidEffectFn2
  monoidEffectFn3
  monoidEffectFn4
  monoidEffectFn5
  monoidEffectFn6
  monoidEffectFn7
  monoidEffectFn8
  monoidEffectFn9
  monoidEffectFn10
Ord
  ordAdditive
  ordConj
  ordDisj
  ordDual
  ordEndo
  ordMultiplicative
  ordBoolean
  ordInt
  ordNumber
  ordString
  ordChar
  ordUnit
  ordVoid
  ordProxy
  ordProxy2
  ordProxy3
  ordArray
  ordOrdering
  ordRecord
  ordFirst
  ordLast
Ring
  ringInt
  ringNumber
  ringUnit
  ringFn
  ringProxy
  ringProxy2
  ringProxy3
  ringRecord
Semigroup
  semigroupAdditive
  semigroupConj
  semigroupDisj
  semigroupDual
  semigroupEndo
  semigroupMultiplicative
  semigroupOrdering
  semigroupString
  semigroupUnit
  semigroupVoid
  semigroupFn
  semigroupArray
  semigroupProxy
  semigroupProxy2
  semigroupProxy3
  semigroupRecord
  semigroupFirst
  semigroupLast
  semigroupEffect
  semigroupEffectFn1
  semigroupEffectFn2
  semigroupEffectFn3
  semigroupEffectFn4
  semigroupEffectFn5
  semigroupEffectFn6
  semigroupEffectFn7
  semigroupEffectFn8
  semigroupEffectFn9
  semigroupEffectFn10
Semigroupoid
  semigroupoidFn
Semiring
  semiringConj
  semiringDisj
  semiringInt
  semiringNumber
  semiringFn
  semiringUnit
  semiringProxy
  semiringProxy2
  semiringProxy3
  semiringRecord
Show
  showNoArguments
  showSum
  showProduct
  showConstructor
  showArgument
  showAdditive
  showConj
  showDisj
  showDual
  showEndo
  showMultiplicative
  showOrdering
  showFirst
  showLast
  showBoolean
  showInt
  showNumber
  showChar
  showString
  showArray
  showProxy
  showProxy2
  showProxy3
  showRecord
  showUnit
  showVoid