data Ins = I | D | L | R | P | G
  deriving (Show)

data Stmt = Ins Ins | Loop Prog
  deriving (Show)

type Prog = [Stmt]

data Syn = Syn [Prog] Prog [Prog]
  deriving (Show)

instance Semigroup Syn where
  Syn lc lp lo <> Syn rc rp ro = go lo [] rc
    where
      go (l:ls) mid (r:rs) = go ls [Loop $ l ++ mid ++ r] rs
      go [] mid (r:rs) = Syn (lc ++ (lp ++ mid ++ r) : rs) rp ro
      go (l:ls) mid [] = Syn lc lp (ro ++ (l ++ mid ++ rp) : ls)
      go [] mid [] = Syn lc (lp ++ mid ++ rp) ro

instance Monoid Syn where
  mempty = Syn [] [] []

embed :: Char -> Syn
embed '+' = Syn [] [Ins I] []
embed '-' = Syn [] [Ins D] []
embed '<' = Syn [] [Ins L] []
embed '>' = Syn [] [Ins R] []
embed '.' = Syn [] [Ins P] []
embed ',' = Syn [] [Ins G] []
embed '[' = Syn [] [] [[]]
embed ']' = Syn [[]] [] []
embed _ = mempty

extract :: Syn -> Maybe Prog
extract (Syn [] prog []) = Just prog
extract _ = Nothing

parse :: String -> Maybe Prog
parse = extract . foldMap embed

main = print $ parse ".[,[-]>[+]<]."