LogicT + Streamly for iterative deepening in constant space

gistfile1.txt

cabal-version:       >=1.10
-- Initial package description 'state-explore.cabal' generated by 'cabal
-- init'.  For further documentation, see
-- http://haskell.org/cabal/users-guide/

name:                state-explore
version:             0.1.0.0
-- synopsis:
-- description:
-- bug-reports:
-- license:
license-file:        LICENSE
author:              Jason Dagit
maintainer:          [email protected]
-- copyright:
-- category:
build-type:          Simple
extra-source-files:  CHANGELOG.md

executable state-explore
  main-is:             Main.hs
  -- other-modules:
  -- other-extensions:
  build-depends:       base >=4.12 && <4.13
  build-depends:       logict
  build-depends:       streamly
  -- hs-source-dirs:
  default-language:    Haskell2010
  ghc-options:         -Wall

Main.hs

{-# language FlexibleInstances #-}
{-# language TypeFamilies #-}
{-# language FlexibleContexts #-}
module Main where

import Streamly
import qualified Streamly.Prelude as S
import Control.Applicative
import Control.Monad.Logic
import Data.Foldable

choose :: (Foldable t, Applicative f) => t a -> LogicT f a
choose = foldr ((<|>) . pure) empty

class Path p where
  type TransitionT p :: *
  extend :: p -> TransitionT p -> p
  emptyP :: p
  depth :: p -> Int
  isValid :: Monad m => p -> TransitionT p -> m Bool

instance Path String where
  type TransitionT String = Char
  extend = flip (:)
  emptyP = []
  depth = length
  isValid _ _ = pure True

pathGenerator :: (Path p, MonadIO m) => Int -> [TransitionT p] -> LogicT m p
pathGenerator maxDepth transitions = asum iterations
  where
  iterations = [ dfs 0 maxD emptyP | maxD <- [1..maxDepth] ]
  dfs d maxD path
    | d >= maxD = pure path
    | otherwise = do
      t <- choose transitions
      guardT $ isValid path t
      dfs (d+1) maxD (extend path t)

guardM :: (Monad m, Alternative m) => m Bool -> m ()
guardM m = guard =<< m

guardT :: (Alternative (t m), MonadTrans t, Monad m, Monad (t m)) => m Bool -> t m ()
guardT = guardM . lift

enumerateLogicT :: (IsStream t, MonadAsync m) => LogicT m a -> t m a
enumerateLogicT = S.unfoldrM (observeT . msplit)

main :: IO ()
main = do
  _ <- S.drainN 20 (S.trace print (enumerateLogicT (pathGenerator 100 "abc":: LogicT IO String)))
  pure ()