{-|
The RLE (run length encoded) format is a common way of representing
patterns in life-like cellular automata. RLE files consist of three
sections:

  1. Zero or more comment lines beginning with @#@

  2. A header of the form @x = [width], y = [height], rule = [rule]@.
  @[width]@ and @[height]@ are natural numbers, and @[rule]@ is the
  rule the pattern is meant to be run in, such as @B36/S23@. The "rule" field
  is optional.

  3. The content of the pattern. @b@ represents a dead cell, @o@ represents
  a live cell, and @$@ denotes the end of a row. A run of identical
  characters can be abbreviated with a number, e.g. @4o@ is short for
  @oooo@ (hence the name "run length encoded"). This section must be
  terminated by a @!@ character.

A glider in the Game of Life could be represented like so:

> #N glider
> x = 3, y = 3, rule = B3/S23
> 3o$2bo$bo!

See this [LifeWiki article](https://conwaylife.com/wiki/Run_Length_Encoded)
for more information.
-}

{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings, FlexibleContexts #-}

module Text.RLE (Rule, parse, make, printAll) where

import qualified Data.Char as Char
import qualified Data.String as String
import qualified Control.Applicative as Ap
import Data.Functor.Identity (Identity)
import Data.String (IsString)

import Text.Parsec
  ( Parsec, Stream, runParser
  , (<|>), try, many, many1, manyTill, satisfy
  , anyChar, digit, string, spaces
  )

import qualified Data.Text.IO as IO

import qualified Data.CA.Pattern as Pat
import Data.CA.Pattern (Pattern)

{-|
A string representing a cellular automaton, such as @"B36/S23"@ or
@"B3/S2-i34q"@.
-}
type Rule = String

data RunType = Dead | Alive | Newline
  deriving (RunType -> RunType -> Bool
(RunType -> RunType -> Bool)
-> (RunType -> RunType -> Bool) -> Eq RunType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunType -> RunType -> Bool
$c/= :: RunType -> RunType -> Bool
== :: RunType -> RunType -> Bool
$c== :: RunType -> RunType -> Bool
Eq)
type Run = (Int, RunType)

data Header = Header Int Int (Maybe Rule)
type RLEData = (Header, [Run])

type Parser s = Parsec s ()

natural :: (Stream s Identity Char) => Parser s Int
natural :: Parser s Int
natural = do
  [Char]
num <- ParsecT s () Identity Char -> ParsecT s () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Int -> Parser s Int
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
num)

symbol :: (Stream s Identity Char) => String -> Parser s ()
symbol :: [Char] -> Parser s ()
symbol [Char]
sym = [Char] -> ParsecT s () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
sym ParsecT s () Identity [Char] -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces

parseWidth :: (Stream s Identity Char) => Parser s Int
parseWidth :: Parser s Int
parseWidth = [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"x" Parser s () -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"=" Parser s () -> Parser s Int -> Parser s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s Int
forall s. Stream s Identity Char => Parser s Int
natural

parseHeight :: (Stream s Identity Char) => Parser s Int
parseHeight :: Parser s Int
parseHeight = [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"," Parser s () -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"y" Parser s () -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"=" Parser s () -> Parser s Int -> Parser s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s Int
forall s. Stream s Identity Char => Parser s Int
natural

parseRule :: (Stream s Identity Char) => Parser s Rule
parseRule :: Parser s [Char]
parseRule = do
  [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"," Parser s () -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"rule" Parser s () -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"="
  [Char]
rule <- ParsecT s () Identity Char -> Parser s [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT s () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace))
  Parser s ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [Char] -> Parser s [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
rule

parseHeader :: (Stream s Identity Char) => Parser s Header
parseHeader :: Parser s Header
parseHeader = (Int -> Int -> Maybe [Char] -> Header)
-> ParsecT s () Identity Int
-> ParsecT s () Identity Int
-> ParsecT s () Identity (Maybe [Char])
-> Parser s Header
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3 Int -> Int -> Maybe [Char] -> Header
Header ParsecT s () Identity Int
forall s. Stream s Identity Char => Parser s Int
parseWidth ParsecT s () Identity Int
forall s. Stream s Identity Char => Parser s Int
parseHeight ParsecT s () Identity (Maybe [Char])
maybeRule
  where maybeRule :: ParsecT s () Identity (Maybe [Char])
maybeRule = ([Char] -> Maybe [Char])
-> ParsecT s () Identity [Char]
-> ParsecT s () Identity (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ParsecT s () Identity [Char]
forall s. Stream s Identity Char => Parser s [Char]
parseRule ParsecT s () Identity (Maybe [Char])
-> ParsecT s () Identity (Maybe [Char])
-> ParsecT s () Identity (Maybe [Char])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe [Char] -> ParsecT s () Identity (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing

parseRunType :: (Stream s Identity Char) => Parser s RunType
parseRunType :: Parser s RunType
parseRunType = ([Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"b" Parser s () -> Parser s RunType -> Parser s RunType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RunType -> Parser s RunType
forall (m :: * -> *) a. Monad m => a -> m a
return RunType
Dead)
  Parser s RunType -> Parser s RunType -> Parser s RunType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"o" Parser s () -> Parser s RunType -> Parser s RunType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RunType -> Parser s RunType
forall (m :: * -> *) a. Monad m => a -> m a
return RunType
Alive)
  Parser s RunType -> Parser s RunType -> Parser s RunType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"$" Parser s () -> Parser s RunType -> Parser s RunType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RunType -> Parser s RunType
forall (m :: * -> *) a. Monad m => a -> m a
return RunType
Newline)

parseRun :: (Stream s Identity Char) => Parser s Run
parseRun :: Parser s Run
parseRun = (Int -> RunType -> Run)
-> ParsecT s () Identity Int
-> ParsecT s () Identity RunType
-> Parser s Run
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 (,) (ParsecT s () Identity Int
forall s. Stream s Identity Char => Parser s Int
natural ParsecT s () Identity Int
-> ParsecT s () Identity Int -> ParsecT s () Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT s () Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1) ParsecT s () Identity RunType
forall s. Stream s Identity Char => Parser s RunType
parseRunType

parseData :: (Stream s Identity Char) => Parser s RLEData
parseData :: Parser s RLEData
parseData = do
  RLEData
rle <- (Header -> [Run] -> RLEData)
-> ParsecT s () Identity Header
-> ParsecT s () Identity [Run]
-> Parser s RLEData
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 (,) ParsecT s () Identity Header
forall s. Stream s Identity Char => Parser s Header
parseHeader (ParsecT s () Identity Run -> ParsecT s () Identity [Run]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s () Identity Run
forall s. Stream s Identity Char => Parser s Run
parseRun)
  [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"!"
  RLEData -> Parser s RLEData
forall (m :: * -> *) a. Monad m => a -> m a
return RLEData
rle

parseComment :: (Stream s Identity Char) => Parser s ()
parseComment :: Parser s ()
parseComment = [Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"#" Parser s ()
-> ParsecT s () Identity [Char] -> ParsecT s () Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s () Identity Char
-> Parser s () -> ParsecT s () Identity [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT s () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar Parser s ()
newline ParsecT s () Identity [Char] -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where newline :: Parser s ()
newline = Parser s () -> Parser s ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> Parser s ()
forall s. Stream s Identity Char => [Char] -> Parser s ()
symbol [Char]
"\n")

parseRLE :: (Stream s Identity Char) => Parser s RLEData
parseRLE :: Parser s RLEData
parseRLE = ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT s () Identity ()
-> ParsecT s () Identity [()] -> ParsecT s () Identity [()]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s () Identity () -> ParsecT s () Identity [()]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s () Identity ()
forall s. Stream s Identity Char => Parser s ()
parseComment ParsecT s () Identity [()] -> Parser s RLEData -> Parser s RLEData
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s RLEData
forall s. Stream s Identity Char => Parser s RLEData
parseData

updateRows :: [Run] -> [[Pat.Cell]] -> [[Pat.Cell]]
updateRows :: [Run] -> [[Cell]] -> [[Cell]]
updateRows = (([Run], [[Cell]]) -> [[Cell]]) -> [Run] -> [[Cell]] -> [[Cell]]
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
  ([], [[Cell]]
rows) -> [[Cell]]
rows
  ((Int
0, RunType
_) : [Run]
runs, [[Cell]]
rows) -> [Run] -> [[Cell]] -> [[Cell]]
updateRows [Run]
runs [[Cell]]
rows

  ((Int
n, RunType
rt) : [Run]
runs, [[Cell]]
rows) -> let
    add :: a -> [[a]] -> [[a]]
add a
cell = \case
      [] -> [[a
cell]]
      ([a]
row : [[a]]
rest) -> (a
cell a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
row) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
rest

    runs' :: [Run]
runs' = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, RunType
rt) Run -> [Run] -> [Run]
forall a. a -> [a] -> [a]
: [Run]
runs

    rows' :: [[Cell]]
rows' = case RunType
rt of
      RunType
Dead -> Cell -> [[Cell]] -> [[Cell]]
forall a. a -> [[a]] -> [[a]]
add Cell
Pat.Dead [[Cell]]
rows
      RunType
Alive -> Cell -> [[Cell]] -> [[Cell]]
forall a. a -> [[a]] -> [[a]]
add Cell
Pat.Alive [[Cell]]
rows
      RunType
Newline -> [] [Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
: [[Cell]]
rows

    in [Run] -> [[Cell]] -> [[Cell]]
updateRows [Run]
runs' [[Cell]]
rows'

toPattern :: RLEData -> (Maybe Rule, Pattern)
toPattern :: RLEData -> (Maybe [Char], Pattern)
toPattern (Header Int
h Int
w Maybe [Char]
rule, [Run]
runs) = let
  rows :: [[Cell]]
rows = [Run] -> [[Cell]] -> [[Cell]]
updateRows ([Run] -> [Run]
forall a. [a] -> [a]
reverse [Run]
runs) []
  pat :: Pattern
pat = Int -> Int -> Pattern -> Pattern
Pat.setDimensions Int
h Int
w ([[Cell]] -> Pattern
Pat.fromList [[Cell]]
rows)
  in (Maybe [Char]
rule, Pattern
pat)

{-|
Parse an RLE file, returning a 'Rule' (if it exists) and a 'Pattern'.
The argument can be 'String', 'Text', or any other type with a 'Stream'
instance.

This parser is fairly liberal. Whitespace is allowed everywhere except
in the middle of a number or rulestring, and there need not be a
newline after the header. Also, text after the final @!@ character is
ignored.
-}
parse :: (Stream s Identity Char) => s -> Maybe (Maybe Rule, Pattern)
parse :: s -> Maybe (Maybe [Char], Pattern)
parse s
str =
  case Parsec s () RLEData
-> () -> [Char] -> s -> Either ParseError RLEData
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
runParser Parsec s () RLEData
forall s. Stream s Identity Char => Parser s RLEData
parseRLE () [Char]
"" s
str of
    Left ParseError
_ -> Maybe (Maybe [Char], Pattern)
forall a. Maybe a
Nothing
    Right RLEData
rle -> (Maybe [Char], Pattern) -> Maybe (Maybe [Char], Pattern)
forall a. a -> Maybe a
Just (RLEData -> (Maybe [Char], Pattern)
toPattern RLEData
rle)

updateRuns :: [[Pat.Cell]] -> [Run] -> [Run]
updateRuns :: [[Cell]] -> [Run] -> [Run]
updateRuns = let
  add :: b -> [(a, b)] -> [(a, b)]
add b
rt = \case
    (a
n, b
rt') : [(a, b)]
runs | b
rt b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
rt' -> (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
rt) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
runs
    [(a, b)]
runs -> (a
1, b
rt) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
runs

  in (([[Cell]], [Run]) -> [Run]) -> [[Cell]] -> [Run] -> [Run]
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
  ([], [Run]
runs) -> [Run] -> [Run]
forall a. [a] -> [a]
reverse [Run]
runs
  ([] : [[Cell]]
rows, [Run]
runs) -> [[Cell]] -> [Run] -> [Run]
updateRuns [[Cell]]
rows (RunType -> [Run] -> [Run]
forall b a. (Eq b, Num a) => b -> [(a, b)] -> [(a, b)]
add RunType
Newline [Run]
runs)
  ((Cell
Pat.Dead : [Cell]
row) : [[Cell]]
rows, [Run]
runs) -> [[Cell]] -> [Run] -> [Run]
updateRuns ([Cell]
row [Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
: [[Cell]]
rows) (RunType -> [Run] -> [Run]
forall b a. (Eq b, Num a) => b -> [(a, b)] -> [(a, b)]
add RunType
Dead [Run]
runs)
  ((Cell
Pat.Alive : [Cell]
row) : [[Cell]]
rows, [Run]
runs) -> [[Cell]] -> [Run] -> [Run]
updateRuns ([Cell]
row [Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
: [[Cell]]
rows) (RunType -> [Run] -> [Run]
forall b a. (Eq b, Num a) => b -> [(a, b)] -> [(a, b)]
add RunType
Alive [Run]
runs)

fromShow :: (Show a, IsString s) => a -> s
fromShow :: a -> s
fromShow = [Char] -> s
forall a. IsString a => [Char] -> a
String.fromString ([Char] -> s) -> (a -> [Char]) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

showRunType :: (IsString s) => RunType -> s
showRunType :: RunType -> s
showRunType = \case
  RunType
Dead -> s
"b"
  RunType
Alive -> s
"o"
  RunType
Newline -> s
"$"

showRun :: (Semigroup s, IsString s) => Run -> s
showRun :: Run -> s
showRun = \case
  (Int
1, RunType
rt) -> RunType -> s
forall s. IsString s => RunType -> s
showRunType RunType
rt
  (Int
n, RunType
rt) -> Int -> s
forall a s. (Show a, IsString s) => a -> s
fromShow Int
n s -> s -> s
forall a. Semigroup a => a -> a -> a
<> RunType -> s
forall s. IsString s => RunType -> s
showRunType RunType
rt

showRuns :: (Semigroup s, IsString s) => Int -> [Run] -> s
showRuns :: Int -> [Run] -> s
showRuns = ((Int, [Run]) -> s) -> Int -> [Run] -> s
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
  (Int
_, []) -> s
""
  (Int
0, [Run]
runs) -> s
"\n" s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Int -> [Run] -> s
forall s. (Semigroup s, IsString s) => Int -> [Run] -> s
showRuns Int
30 [Run]
runs
  (Int
n, Run
run : [Run]
runs) -> Run -> s
forall s. (Semigroup s, IsString s) => Run -> s
showRun Run
run s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Int -> [Run] -> s
forall s. (Semigroup s, IsString s) => Int -> [Run] -> s
showRuns (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Run]
runs

{-|
Convert a 'Pattern' into an RLE. If the first argument is 'Nothing',
the generated RLE will have no "rule" field in its header.
-}
make :: (Semigroup s, IsString s) => Maybe Rule -> Pattern -> s
make :: Maybe [Char] -> Pattern -> s
make Maybe [Char]
rule Pattern
pat = let
  x :: s
x = s
"x = " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Int -> s
forall a s. (Show a, IsString s) => a -> s
fromShow (Pattern -> Int
Pat.width Pattern
pat)
  y :: s
y = s
", y = " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Int -> s
forall a s. (Show a, IsString s) => a -> s
fromShow (Pattern -> Int
Pat.height Pattern
pat)
  r :: s
r = case Maybe [Char]
rule of
    Maybe [Char]
Nothing -> s
""
    Just [Char]
str -> s
", rule = " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [Char] -> s
forall a. IsString a => [Char] -> a
String.fromString [Char]
str
  runs :: [Run]
runs = [[Cell]] -> [Run] -> [Run]
updateRuns (Pattern -> [[Cell]]
Pat.toList Pattern
pat) []
  in s
x s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
y s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
r s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"\n" s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Int -> [Run] -> s
forall s. (Semigroup s, IsString s) => Int -> [Run] -> s
showRuns Int
30 [Run]
runs s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"!\n"

{-|
Convert a list of patterns into RLEs and print them. Example:

> import qualified Text.RLE as RLE
> import Data.CA.List (withDimensions)
> main = RLE.printAll (Just "B3/S23") (withDimensions 4 4)

The program above will print the RLE of every possible pattern
contained in a 4 by 4 square. This data can then be piped into another
program such as apgsearch.
-}
printAll :: Maybe Rule -> [Pattern] -> IO ()
printAll :: Maybe [Char] -> [Pattern] -> IO ()
printAll Maybe [Char]
rule = (Pattern -> IO ()) -> [Pattern] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
IO.putStrLn (Text -> IO ()) -> (Pattern -> Text) -> Pattern -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> Pattern -> Text
forall s. (Semigroup s, IsString s) => Maybe [Char] -> Pattern -> s
make Maybe [Char]
rule)