-- |
-- Module      : AOC.Challenge.Day05
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 5.  See "AOC.Solver" for the types used in this module!
--
-- Note that this is slow in the current version of "Data.Group.Free" on
-- hackage.  See https://github.com/mstksg/free-algebras/tree/freegroup2
-- for a version that is efficient.
--
-- See <https://blog.jle.im/entry/alchemical-groups.html> for an
-- explaination.

module AOC.Challenge.Day05 (
    day05a
  , day05b
  ) where

import           AOC.Common        (deleteFinite)
import           AOC.Solver        ((:~>)(..))
import           Data.Algebra.Free (returnFree, foldMapFree)
import           Data.Char         (ord, toLower, isLower)
import           Data.Finite       (Finite, packFinite, finites)
import           Data.Group        (invert)
import           Data.Group.Free   (FreeGroupL)
import qualified Data.Group.Free   as G

-- | One of the generators from the full alphabet
type Elem  = Finite 26

charElem
    :: Char
    -> Maybe (Either Elem Elem)     -- left if lower, right if upper
charElem c
    | isLower c = Left <$> i
    | otherwise = Right <$> i
  where
    i = packFinite (fromIntegral (ord (toLower c) - ord 'a'))

inject
    :: Char
    -> FreeGroupL Elem
inject = foldMap (either returnFree (invert . returnFree)) . charElem

day05a :: FreeGroupL Elem :~> Int
day05a = MkSol
    { sParse = Just . foldMap inject
    , sShow  = show
    , sSolve = Just . length . G.toList
    }

day05b :: FreeGroupL Elem :~> Int
day05b = MkSol
    { sParse = Just . foldMap inject
    , sShow  = show
    , sSolve = \xs -> Just $ minimum
        [ length . G.toList $ foldMapFree (ghomo c) xs
        | c <- finites
        ]
    }
  where
    -- | Delete a letter from the group
    ghomo :: Elem -> Elem -> FreeGroupL (Finite 25)
    ghomo c = foldMap returnFree . deleteFinite c

-- -------------
-- | Old Methods
-- -------------

-- anti :: Char -> Char -> Bool
-- anti x y = toLower x == toLower y && x /= y

-- cons :: Char -> String -> String
-- x `cons` (y:xs)
--     | anti x y  = xs
--     | otherwise = x:y:xs
-- x `cons` []     = [x]

-- day05a :: String :~> Int
-- day05a = MkSol
--     { sParse = Just
--     , sShow  = show
--     , sSolve = Just . length . foldr cons []
--     }

-- day05b :: String :~> Int
-- day05b = MkSol
--     { sParse = Just
--     , sShow  = show
--     , sSolve = \xs -> Just $ minimum [ length $ foldr cons [[] (remove c xs)
--                                      | c <- ['a' .. 'z']
--                                      ]
--     }
--   where
--     remove c = filter $ (/= c) . toLower