oh god why

import System.IO
import Control.Monad
import Control.Arrow
import Data.List (break, find, unfoldr)
import System.Environment
import qualified System.Console.Terminal.Size as TS
import Data.Map (empty, insert, adjust, keys, findWithDefault, lookup, fromList, Map)

data Var = I Int | S String | P String | B Bool | N (IO ())
data Graph = Edge String [Path] | Func [Path] | Orphan String | Label String | Return deriving Show
data Path = Choice [String] [String] Graph String | Auto [String] [String] | Exec [String] [String] Graph | Print String deriving Show

instance Show Var where
    show (B x) = show x
    show (I x) = show x
    show (S x) = x
    show (P x) = x
    show (N _) = "()"

instance Eq Var where
    (I a) == (I b) = a == b
    (S a) == (S b) = a == b
    (B a) == (B b) = a == b
    _ == _ = False

instance Ord Var where
    compare (I a) (I b) | a == b = EQ
                        | a > b = GT
                        | a < b = LT

xor True False  = True
xor False True  = True
xor True True   = False
xor False False = False

wordWrap Nothing string = string
wordWrap (Just x) string = wordWrap' (TS.width x) string
wordWrap' w = foldl1 (wrapper w) . words where
    lastLine        = length . last . lines
    wrapper w acc x = if lastLine acc + length x + 1 >= w then acc ++ "\n" ++ x else acc ++ " " ++ x

nodeMap = fromList . decompose . fst . murder ([], []) . map words . filter ((/=) '#' . head) . filter (/= "") . lines where
    decompose = map (extractLabel &&& processGraph) . map splitColons
    murder = foldr (\x (a, c) -> if (head x `elem` ["function", "node"]) then ((x:c) : a, []) else (a, x : c))
findNode file k = findWithDefault (Orphan "ERROR: Label not found!") k $ nodeMap file

lookupVar :: String -> Map String Var -> Var
lookupVar k m = lookupVar' (fst $ break (=='_') k) (Data.Map.lookup k m) where
    lookupVar' y (Just x)     = x
    lookupVar' "s" Nothing    = S ""
    lookupVar' "i" Nothing    = I 0
    lookupVar' "b" Nothing    = B False

reader vars "true"  = B True
reader vars "false" = B False
reader vars x | all (flip elem ['-','0','1','2','3','4','5','6','7','8','9']) x = I (read x)
              | head x == '"' && last x == '"'                                  = S x
              | otherwise                                                       = lookupVar x vars

splitColons = map (unfoldr (\x -> if (length x > 0) then (Just $ (id *** (\z -> if (length z > 0) then (tail z) else z)) $ break (==":") x) else Nothing))

substituteVars vars string = unwords $ map (\x -> if (x `elem` keys vars) then (show $ lookupVar x vars) else x) $ words string

unVarB (B x) = x
unVarI (I x) = x
unVarS (S x) = x

adjustWithDefault :: Ord k => a -> (a -> a) -> k -> Map k a -> Map k a
adjustWithDefault d f k m = if k `notElem` keys m then insert k (f d) m else insert k (f $ findWithDefault d k m) m

execute vars = foldr execute' (vars, []) where
    execute' "=" (v, xs)   = (v, (P "="):xs)
    execute' "++" (v, xs)   = (v, (P "++"):xs)
    execute' "--" (v, xs)   = (v, (P "--"):xs)
    execute' "+=" (v, xs)   = (v, (P "+="):xs)
    execute' "-=" (v, xs)   = (v, (P "-="):xs)
    execute' "*=" (v, xs)   = (v, (P "*="):xs)
    execute' "/=" (v, xs)   = (v, (P "/="):xs)
    execute' "%=" (v, xs)   = (v, (P "%="):xs)
    execute' x (v, P "=":y:xs)      = (insert x y v, xs)
    execute' x (v, (P "++"):xs)     = (adjustWithDefault (I 0) (I . succ . unVarI) x v, xs)
    execute' x (v, (P "--"):xs)     = (adjustWithDefault (I 0) (I . pred . unVarI) x v, xs)
    execute' x (v, (P "+="):y:xs)   = (adjustWithDefault (I 0) (I . (+) (unVarI y) . unVarI) x v, xs)
    execute' x (v, (P "-="):y:xs)   = (adjustWithDefault (I 0) (I . (flip (-)) (unVarI y) . unVarI) x v, xs)
    execute' x (v, (P "*="):y:xs)   = (adjustWithDefault (I 0) (I . (*) (unVarI y) . unVarI) x v, xs)
    execute' x (v, (P "/="):y:xs)   = (adjustWithDefault (I 0) (I . (flip div) (unVarI y) . unVarI) x v, xs)
    execute' x (v, (P "mod="):y:xs) = (adjust (I . (flip mod) (unVarI y) . unVarI) x v, xs)
    execute' "set" (v, x:y:xs)      = (insert (read $ unVarS x) y v, xs)
    execute' "setT" (v, x:xs)       = (insert (read $ unVarS x) (B True) v, xs)
    execute' "setF" (v, x:xs)       = (insert (read $ unVarS x) (B False) v, xs)
    execute' "succ" (v, x:xs)       = (adjustWithDefault (I 0) (I . succ . unVarI) (read $ unVarS x) v, xs)
    execute' "pred" (v, x:xs)       = (adjustWithDefault (I 0) (I . pred . unVarI) (read $ unVarS x) v, xs)
    execute' "if" (v, z:x:y:xs)     = if (unVarB z) then (v, x:xs) else (v, y:xs)
    execute' "eq" (v, x:y:xs)       = (v, B (x == y) : xs)
    execute' "lt" (v, x:y:xs)       = (v, B (x < y) : xs)
    execute' "gt" (v, x:y:xs)       = (v, B (x > y) : xs)
    execute' "le" (v, x:y:xs)       = (v, B (x <= y) : xs)
    execute' "ge" (v, x:y:xs)       = (v, B (x >= y) : xs)
    execute' "and" (v, x:y:xs)      = (v, B (unVarB x && unVarB y) : xs)
    execute' "or" (v, x:y:xs)       = (v, B (unVarB x || unVarB y) : xs)
    execute' "xor" (v, x:y:xs)      = (v, B (unVarB x `xor` unVarB y) : xs)
    execute' "not" (v, x:xs)        = (v, B (not $ unVarB x) : xs)
    execute' "plus" (v, x:y:xs)     = (v, I (unVarI x + unVarI y) : xs)
    execute' "minus" (v, x:y:xs)    = (v, I (unVarI x - unVarI y) : xs)
    execute' "mult" (v, x:y:xs)     = (v, I (unVarI x * unVarI y) : xs)
    execute' "div" (v, x:y:xs)      = (v, I (unVarI x `div` unVarI y) : xs)
    execute' "mod" (v, x:y:xs)      = (v, I (unVarI x `mod` unVarI y) : xs)
    execute' "print" (v, x:xs)      = (v, N (print $ unVarS x) : xs)
    execute' x (v, xs)              = (v, (reader v x):xs)

extractType = head . head . head
extractLabel = head . tail . head . head
extractIntro = unwords . head . tail . head
extractChoices = tail
extractor s q              = if (z == Nothing) then [] else (\(Just j) -> tail j) z where z = find (\x -> head x == s) q
extractConditionChoice     = extractor "show"
extractActionChoice        = extractor "choice"
extractConditionFunction   = extractor "exec"
extractActionFunction      = extractor "do"

extractTarget :: [[String]] -> Maybe [[Char]]
extractTarget = find (\x -> head x == "goto" || head x == "return")
makePathFunction c a Nothing  = Auto c a
makePathFunction c a (Just x) = if (head x == "goto") then Exec c a (Label $ head $ tail x) else Exec c a Return
makePathChoice c a (Just x) l = if (head x == "goto") then Choice c a (Label $ head $ tail x) l else Choice c a Return l
makePath c               = if (extractActionFunction c /= []) then makePathFunction (extractConditionFunction c) (extractActionFunction c) (extractTarget c) else makePathChoice (extractConditionChoice c) (extractActionChoice c) (extractTarget c) (unwords $ last c)

processGraph x = if (extractType x == "node") then (if (length (extractChoices x) == 0) then Orphan (extractIntro x) else Edge (extractIntro x) (map makePath $ extractChoices x)) else Func (map makePath $ extractChoices x)

unfoldGraph file (Orphan a) = Orphan a
unfoldGraph file Return     = Return
unfoldGraph file (Label a)  = unfoldGraph file $ findNode file a
unfoldGraph file (Edge intro actions) = Edge intro $ map (transformPath file) actions
unfoldGraph file (Func actions)       = Func $ map (transformPath file) actions

transformPath file (Choice a b g d)    = Choice a b (unfoldGraph file g) d
transformPath file (Exec a b g)        = Exec a b (unfoldGraph file g)
transformPath file (Auto a b)          = Auto a b

expandGraph file = unfoldGraph file . findNode file

checkChoice (Choice _ _ _ _) = True
checkChoice _                = False
checkExec (Exec _ _ _)       = True
checkExec _                  = False
checkAuto (Auto _ _)         = True
checkAuto _                  = False
checkPrint (Print _)         = True
checkPrint _                 = False

nextGraph (Choice _ _ g _)   = g
nextGraph (Exec _ _ g)       = g

walkGraph size vars (x:y:xs, Return)         = walkGraph size vars (xs, y)
walkGraph size vars (_, Orphan a)            = do
    putStrLn $ wordWrap size $ substituteVars vars a
    putStrLn "Press enter to exit..."
    getLine
walkGraph size vars (xs, Func actions)       = walkFunc size vars (Func actions : xs, filter checkAuto actions, find checkValid actions) where
    checkValid (Exec cond _ _) = and $ map unVarB $ snd $ execute vars cond
    checkValid _ = False
walkGraph size vars (xs, Edge intro actions) = walkEdge size vars (Edge intro actions : xs, filter checkAuto actions, intro, filter checkChoice actions)

runAuto acc (Auto cond f) = if (and $ map unVarB $ snd $ execute acc cond) then (fst $ execute acc f) else acc
walkFunc size vars (xs, autos, Just exec) = walkExec size (foldl runAuto vars autos) (xs, exec)

walkExec size vars (xs, Exec cond f g) = walkGraph size (if (and $ map unVarB $ snd $ execute vars cond) then (fst $ execute vars f) else vars) (xs, g)
walkEdge size vars (xs, autos, intro, choices) = walkChoice size (foldl runAuto vars autos) (xs, intro, choices)

walkChoice size vars (xs, intro, choices) = do
    putStrLn $ wordWrap size $ substituteVars vars intro
    valid <- return $ filter (\(Choice cond _ _ _) -> and $ map unVarB $ snd $ execute vars cond) choices
    if (length valid > 1)
        then do
              mapM_ (\(a, Choice _ _ _ label) -> putStrLn $ wordWrap size $ show a ++ ". " ++ (substituteVars vars label)) $ zip [1..length valid] valid
              r <- getLine
              (Choice cond f g label) <- return $ valid !! (pred $ read r)
              walkGraph size (fst $ execute vars f) (xs, g)
        else do
              (Choice cond f g label) <- return $ head valid
              putStrLn $ wordWrap size $ substituteVars vars label
              getLine
              walkGraph size (fst $ execute vars f) (xs, g)

main = do
    args <- getArgs
    handle <- openFile (head args) ReadMode
    contents <- hGetContents handle
    size <- TS.size
    walkGraph size empty $ ([], expandGraph contents "_start")
    hClose handle