{-# LANGUAGE RecordWildCards #-}
module Main where

import           Control.Arrow.Notation
import           Data.List
import           Debug.Hoed.Pure
import           Language.Haskell.Exts
import           System.Environment
import           System.Exit
import           System.IO
import           Text.Printf

usage :: String -> String
usage progName = unlines [
  "usage: " ++ progName ++
  " [FILENAME] [SOURCE] [DEST]",
  "Read arrow notation from SOURCE (derived from FILENAME) and write",
  "standard Haskell to DEST.",
  "If no FILENAME, use SOURCE as the original name.",
  "If no DEST or if DEST is `-', write to standard output.",
  "If no SOURCE or if SOURCE is `-', read standard input."
  ]

main :: IO ()
main = runO $ do
  args <- getArgs
  progName <- getProgName
  (orig, inp, out) <- case args of
    ["--help"] -> do
      putStrLn $ usage progName
      exitSuccess
    []     -> return ("input",Nothing,Nothing)
    [i]    -> return (i, Just i, Nothing)
    [i,o]  -> return (i, Just i, Just o)
    [orig,i,o] -> return (orig, Just i, Just o)
    _ -> do
      putStrLn $ usage progName
      error "Unrecognized set of command line arguments"
  hIn  <- maybe (return stdin)  (`openFile` ReadMode) inp
  hOut <- maybe (return stdout) (`openFile` WriteMode) out
  contents <- hGetContents hIn
  case parseFileContentsWithExts defaultExtensions contents of
        ParseFailed SrcLoc{..} err -> do
          printf "Parse error at %s:%d:%d: %s" orig srcLine srcColumn err
          exitFailure
        ParseOk x -> do
          let x' = translateModule x
          hPutStr hOut $ prettyPrintWithMode defaultMode{linePragmas=True} x'
          hClose hOut

defaultExtensions :: [Extension]
defaultExtensions = [e | e@EnableExtension{} <- knownExtensions] \\ map EnableExtension badExtensions

badExtensions :: [KnownExtension]
badExtensions =
    [TransformListComp -- steals the group keyword
    ,XmlSyntax, RegularPatterns -- steals a-b
    ,UnboxedTuples -- breaks (#) lens operator
    ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break
    ,DoRec, RecursiveDo -- breaks rec
    ,TypeApplications -- HSE fails on @ patterns
    ]