{-# Language ImportQualifiedPost, OverloadedStrings, QuasiQuotes #-}
{-|
Module      : Main
Description : Day 19 solution
Copyright   : (c) Eric Mertens, 2020
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2020/day/19>

Run a parser define by a simple list of alternatives of sequences or
literal matches.

-}
module Main (main) where

import Advent (countBy, format)
import Advent.ReadS (P(..), char, eof)
import Data.Foldable (traverse_, asum)
import Data.Functor (void)
import Data.IntMap qualified as IntMap
import Data.IntMap (IntMap)

-- | Rules either match a literal string, or match a sum
-- of product of sub-rules.
type Rule = Either Char [[Int]]

------------------------------------------------------------------------

-- | Print answers.
--
-- >>> :main
-- 180
-- 323
main :: IO ()
IO ()
main =
 do ([(Int, Either Char [[Int]])]
rs,[[Char]]
ws) <- [format|2020 19 (%u: ("%c"|%u& &( %| ))%n)*%n(%s%n)*|]
    let rules1 :: IntMap (Either Char [[Int]])
rules1 = [(Int, Either Char [[Int]])] -> IntMap (Either Char [[Int]])
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, Either Char [[Int]])]
rs
        rules2 :: IntMap (Either Char [[Int]])
rules2 = Int
-> Either Char [[Int]]
-> IntMap (Either Char [[Int]])
-> IntMap (Either Char [[Int]])
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert  Int
8 ([[Int]] -> Either Char [[Int]]
forall a b. b -> Either a b
Right [[Int
42   ],[Int
42, Int
8   ]])
               (IntMap (Either Char [[Int]]) -> IntMap (Either Char [[Int]]))
-> IntMap (Either Char [[Int]]) -> IntMap (Either Char [[Int]])
forall a b. (a -> b) -> a -> b
$ Int
-> Either Char [[Int]]
-> IntMap (Either Char [[Int]])
-> IntMap (Either Char [[Int]])
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
11 ([[Int]] -> Either Char [[Int]]
forall a b. b -> Either a b
Right [[Int
42,Int
31],[Int
42,Int
11,Int
31]])
               (IntMap (Either Char [[Int]]) -> IntMap (Either Char [[Int]]))
-> IntMap (Either Char [[Int]]) -> IntMap (Either Char [[Int]])
forall a b. (a -> b) -> a -> b
$ IntMap (Either Char [[Int]])
rules1
    Int -> IO ()
forall a. Show a => a -> IO ()
print (IntMap (Either Char [[Int]]) -> [[Char]] -> Int
run IntMap (Either Char [[Int]])
rules1 [[Char]]
ws)
    Int -> IO ()
forall a. Show a => a -> IO ()
print (IntMap (Either Char [[Int]]) -> [[Char]] -> Int
run IntMap (Either Char [[Int]])
rules2 [[Char]]
ws)

-- | Count the number of input strings that satisfy the parse rules.
run ::
  IntMap Rule {- ^ parse rules                      -} ->
  [String]    {- ^ input strings                    -} ->
  Int         {- ^ number of matching input strings -}
run :: IntMap (Either Char [[Int]]) -> [[Char]] -> Int
run IntMap (Either Char [[Int]])
rules = ([Char] -> Bool) -> [[Char]] -> Int
forall (f :: * -> *) a. Foldable f => (a -> Bool) -> f a -> Int
countBy (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((), [Char])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([((), [Char])] -> Bool)
-> ([Char] -> [((), [Char])]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [((), [Char])]
topParser)
  where
    topParser :: ReadS ()
    P [Char] -> [((), [Char])]
topParser = IntMap (P ())
parsers IntMap (P ()) -> Int -> P ()
forall a. IntMap a -> Int -> a
IntMap.! Int
0 P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
eof

    parsers :: IntMap (P ())
    parsers :: IntMap (P ())
parsers = Either Char [[Int]] -> P ()
ruleParser (Either Char [[Int]] -> P ())
-> IntMap (Either Char [[Int]]) -> IntMap (P ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (Either Char [[Int]])
rules

    ruleParser :: Rule -> P ()
    ruleParser :: Either Char [[Int]] -> P ()
ruleParser = (Char -> P ()) -> ([[Int]] -> P ()) -> Either Char [[Int]] -> P ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (P () -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P () -> P ()) -> (Char -> P ()) -> Char -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> P ()
char) ([P ()] -> P ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([P ()] -> P ()) -> ([[Int]] -> [P ()]) -> [[Int]] -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> P ()) -> [[Int]] -> [P ()]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> P ()
order)

    order :: [Int] -> P ()
    order :: [Int] -> P ()
order = (Int -> P ()) -> [Int] -> P ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IntMap (P ())
parsers IntMap (P ()) -> Int -> P ()
forall a. IntMap a -> Int -> a
IntMap.!)