{-|
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.
-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings, FlexibleContexts #-}

module Text.RLE (Rule, parse, parseMany, 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 Data.Text(Text)

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)
-> Int -> Int -> Maybe [Char] -> Header
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many 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] -> [[Bool]] -> [[Bool]]
updateRows = (([Run], [[Bool]]) -> [[Bool]]) -> [Run] -> [[Bool]] -> [[Bool]]
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
  ([], [[Bool]]
rows) -> [[Bool]]
rows
  ((Int
0, RunType
_) : [Run]
runs, [[Bool]]
rows) -> [Run] -> [[Bool]] -> [[Bool]]
updateRows [Run]
runs [[Bool]]
rows

  ((Int
n, RunType
rt) : [Run]
runs, [[Bool]]
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' :: [[Bool]]
rows' = case RunType
rt of
      RunType
Dead -> Bool -> [[Bool]] -> [[Bool]]
forall a. a -> [[a]] -> [[a]]
add Bool
False [[Bool]]
rows
      RunType
Alive -> Bool -> [[Bool]] -> [[Bool]]
forall a. a -> [[a]] -> [[a]]
add Bool
True [[Bool]]
rows
      RunType
Newline -> [] [Bool] -> [[Bool]] -> [[Bool]]
forall a. a -> [a] -> [a]
: [[Bool]]
rows

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

toPattern :: RLEData -> (Maybe Rule, Pattern)
toPattern :: RLEData -> (Maybe [Char], Pattern)
toPattern (Header Int
h Int
w Maybe [Char]
rule, [Run]
runs) = let
  rows :: [[Bool]]
rows = [Run] -> [[Bool]] -> [[Bool]]
updateRows ([Run] -> [Run]
forall a. [a] -> [a]
reverse [Run]
runs) []
  pat :: Pattern
pat = Int -> Int -> Pattern -> Pattern
Pat.setDimensions Int
h Int
w ([[Bool]] -> Pattern
Pat.fromList [[Bool]]
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.

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)

{-|
Parse zero or more RLE files. The argument can be 'String', 'Text', or
any other type with a 'Stream' instance.
-}
parseMany :: (Stream s Identity Char) => s -> Maybe [(Maybe Rule, Pattern)]
parseMany :: s -> Maybe [(Maybe [Char], Pattern)]
parseMany 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 (ParsecT s () Identity RLEData -> Parsec s () [RLEData]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s () Identity 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]
rles -> [(Maybe [Char], Pattern)] -> Maybe [(Maybe [Char], Pattern)]
forall a. a -> Maybe a
Just ((RLEData -> (Maybe [Char], Pattern))
-> [RLEData] -> [(Maybe [Char], Pattern)]
forall a b. (a -> b) -> [a] -> [b]
map RLEData -> (Maybe [Char], Pattern)
toPattern [RLEData]
rles)

updateRuns :: [[Pat.Cell]] -> [Run] -> [Run]
updateRuns :: [[Bool]] -> [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 (([[Bool]], [Run]) -> [Run]) -> [[Bool]] -> [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
  ([] : [[Bool]]
rows, [Run]
runs) -> [[Bool]] -> [Run] -> [Run]
updateRuns [[Bool]]
rows (RunType -> [Run] -> [Run]
forall b a. (Eq b, Num a) => b -> [(a, b)] -> [(a, b)]
add RunType
Newline [Run]
runs)
  ((Bool
False : [Bool]
row) : [[Bool]]
rows, [Run]
runs) -> [[Bool]] -> [Run] -> [Run]
updateRuns ([Bool]
row [Bool] -> [[Bool]] -> [[Bool]]
forall a. a -> [a] -> [a]
: [[Bool]]
rows) (RunType -> [Run] -> [Run]
forall b a. (Eq b, Num a) => b -> [(a, b)] -> [(a, b)]
add RunType
Dead [Run]
runs)
  ((Bool
True : [Bool]
row) : [[Bool]]
rows, [Run]
runs) -> [[Bool]] -> [Run] -> [Run]
updateRuns ([Bool]
row [Bool] -> [[Bool]] -> [[Bool]]
forall a. a -> [a] -> [a]
: [[Bool]]
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 = [[Bool]] -> [Run] -> [Run]
updateRuns (Pattern -> [[Bool]]
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)