regex.hs

-# LANGUAGE LambdaCase #-}

module Main where

import Data.List
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)
import Prelude

main :: IO ()
main = do
  input <-
    getArgs >>= \case
      [] -> do
        pn <- getProgName
        putStrLn $ "Usage: " <> pn <> " <the.regexes>"
        exitFailure
      (fn : _) -> readFile fn
  print $ solve input

solve :: String -> [(Int, String, String)]
solve = map solveRegex . lines

solveRegex :: String -> (Int, String, String)
solveRegex s =
  let regex = parseRegex s
      simplified = simplify regex
   in (countOptions simplified, renderRegex regex, renderRegex simplified)

data Regex
  = One Char
  | And [Regex]
  | Or [Regex]
  deriving (Show, Eq)

-- | Render a regex back to a string
renderRegex :: Regex -> String
renderRegex = \case
  One c -> [c]
  And rs -> ['('] ++ concatMap renderRegex rs ++ [')']
  Or rs -> ['['] ++ concatMap renderRegex rs ++ [']']

-- | Parse a regex
--
-- Assumes balancing
parseRegex :: String -> Regex
parseRegex = And . go
  where
    go :: String -> [Regex]
    go = \case
      [] -> []
      ('(' : rest) -> let (ands, leftovers) = goAnd [] rest in And ands : go leftovers
      ('[' : rest) -> let (ors, leftovers) = goOr [] rest in Or ors : go leftovers
      (c : rest) -> One c : go rest
    goAnd :: [Regex] -> String -> ([Regex], String)
    goAnd acc = \case
      [] -> undefined -- Should not happen.
      (')' : rest) -> (acc, rest)
      ('(' : rest) -> let (ands, leftovers) = goAnd [] rest in goAnd (acc ++ [And ands]) leftovers
      ('[' : rest) -> let (ors, leftovers) = goOr [] rest in goAnd (acc ++ [Or ors]) leftovers
      (']' : rest) -> undefined -- Should not happen.
      (c : rest) -> goAnd (acc ++ [One c]) rest

    goOr :: [Regex] -> String -> ([Regex], String)
    goOr acc = \case
      [] -> undefined -- Should not happen.
      (']' : rest) -> (acc, rest)
      ('[' : rest) -> let (ors, leftovers) = goOr [] rest in goOr (acc ++ [Or ors]) leftovers
      ('(' : rest) -> let (ands, leftovers) = goAnd [] rest in goOr (acc ++ [And ands]) leftovers
      (')' : rest) -> undefined -- Should not happen.
      (c : rest) -> goOr (acc ++ [One c]) rest

-- | Simplifies into an equivalent regex
simplify :: Regex -> Regex
simplify = go
  where
    go :: Regex -> Regex
    go = \case
      One c -> One c
      And [r] -> go r
      And rs -> And $ concatMap goAnd rs
      Or [r] -> go r
      Or rs -> Or $ nub $ concatMap goOr rs
    goAnd :: Regex -> [Regex]
    goAnd = \case
      One c -> [go $ One c]
      And rs -> map go $ concatMap goAnd rs
      Or rs -> [go $ Or rs]
    goOr :: Regex -> [Regex]
    goOr = \case
      One c -> [go $ One c]
      And rs -> [go $ And rs]
      Or rs -> map go $ concatMap goOr rs

-- Must be simplified
countOptions :: Regex -> Int
countOptions = \case
  One _ -> 1
  And rs -> product $ map countOptions rs
  Or rs -> sum $ map countOptions rs