module RE where
import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.Examples
data RE = Epsilon | Leaf Char | Selection RE RE | Sequence RE RE | Kleene RE | Optional RE | End
re_to_fsm :: RE -> Parser String
re_to_fsm re = case re of
Leaf c -> lift <$> pSym c
Selection re1 re2 -> re_to_fsm re1 <|> re_to_fsm re2
Sequence re1 re2 -> (++) <$> re_to_fsm re1 <*> re_to_fsm re2
Kleene re -> concat <$> pList (re_to_fsm re)
Optional re -> re_to_fsm re `opt` ""
End -> pure ""
t = re_to_fsm ((Kleene (Leaf 'a') `Sequence` Kleene (Leaf 'b')) `Selection` (Kleene (Leaf 'a') `Sequence` (Kleene (Leaf 'c') )))
t1 = run t "aaabbb"
t2 = run t "aaaaccccccc"
t3 = run t "aaddcc"
*RE> t1
--
-- > Result: "aaabbb"
--
*RE> t2
--
-- > Result: "aaaaccccccc"
--
*RE> t3
--
-- > Result: "aacc"
-- > Correcting steps:
-- > Deleted 'd' at position 2 expecting one of ['a', 'c', 'a', 'b']
-- > Deleted 'd' at position 3 expecting 'c'
--
*RE>