Attempt at recursion-schemes

DigitalPlumber.hs

import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.List.Split (splitOn)
import Data.List (stripPrefix)
import Data.Maybe (fromJust)

newtype Fix f = In { out :: f (Fix f) } 


type Algebra f a = f a -> a
cata :: (Functor f) => Algebra f a -> Fix f -> a  
cata f = f . fmap (cata f) . out

type Coalgebra f a = a -> f a
ana :: (Functor f) => Coalgebra f a -> a -> Fix f  
ana f = In . fmap (ana f) . f


hylo :: Functor f => Algebra f a -> Coalgebra f b -> b -> a
hylo f g = h where h = f . fmap h . g

data PipeGraph a =
     PipeGraph Int [a]
     deriving (Eq,Show,Functor)


data Pipes =
     Pipes Int [Pipes]
     deriving (Eq,Show)



type GoodGraph = Fix PipeGraph



input = readFile "./test/Golden/DigPlum.txt"

sample = "0 <-> 2\n1 <-> 1\n2 <-> 0, 3, 4\n3 <-> 2, 4\n4 <-> 2, 3, 6\n5 <-> 6\n6 <-> 4, 5"

bmap f f' (x,y) = (f x, f' y)

handleLine :: String -> (Int, [Int])
handleLine =  bmap read (map read. splitOn ", ") . fmap (fromJust . stripPrefix " <-> ") .  span (/=' ')
                   
toMap :: String -> Map Int [Int]
toMap = M.fromList . map handleLine . lines

getPair :: Ord k => Map k v -> k -> (k,v)
getPair m key = (key,  m ! key)

buildGraph :: Map Int [Int] -> Coalgebra PipeGraph Int
buildGraph master k = let (z,zs) = getPair master k in PipeGraph z zs

deconGraph :: Algebra PipeGraph Pipes
deconGraph (PipeGraph z zs) = Pipes z zs

toPipes :: Map Int [Int] -> Int -> Pipes
toPipes m = hylo deconGraph (buildGraph m )

getUniq :: Pipes -> Set Int
getUniq (Pipes n ps) = go (S.singleton n) ps
  where go xs [] = xs
        go xs ((Pipes a as):zs) = if a `S.member` xs
                          then go xs zs
                          else go (S.insert a xs) (zs ++ as)

numberOfMembersFromZero :: IO ()
numberOfMembersFromZero = do
  baseM <- toMap <$> input
  let resSet = getUniq . toPipes baseM $ 0
  print resSet
  putStrLn "Length Was: "
  print (S.size resSet)

uniqueGroups :: IO ()
uniqueGroups = do
  baseM <- toMap <$> input
  let resGroups = M.elems $ M.mapKeys (getUniq . toPipes baseM) baseM
  putStrLn "Number of unique groups:"
  print $ S.size (S.fromList resGroups)