Main.hs

{-# LANGUAGE Unsafe #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- | Main entry point to hindent.
--
-- hindent
module Main where

import           Control.Applicative
import           Control.Exception
import qualified Data.ByteString as S
import qualified Data.ByteString.Builder as S
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Version (showVersion)
import qualified Data.Yaml as Y
import           Descriptive
import           Descriptive.Options
import           Foreign.C.Error
import           GHC.IO.Exception
import           HIndent
import           HIndent.Types
import           Language.Haskell.Exts hiding (Style, style)
import           Path
import qualified Path.Find as Path
import qualified Path.IO as Path
import           Paths_hindent (version)
import qualified System.Directory as IO
import           System.Environment
import qualified System.IO as IO
import           Text.Read

-- | Main entry point.
main :: IO ()
main = do
  args <- getArgs
  config <- getConfig
  case consume (options config) (map T.pack args) of
    Succeeded (style, exts, mfilepath) ->
      case mfilepath of
        Just filepath -> do
          text <- S.readFile filepath
          tmpDir <- IO.getTemporaryDirectory
          (fp, h) <- IO.openTempFile tmpDir "hindent.hs"
          case reformat style (Just exts) text of
            Left e -> error (filepath ++ ": " ++ e)
            Right out -> do
              L8.hPutStr h (S.toLazyByteString out)
              IO.hFlush h
              IO.hClose h
              let exdev e =
                    if ioe_errno e == Just ((\(Errno a) -> a) eXDEV)
                      then IO.copyFile fp filepath >> IO.removeFile fp
                      else throw e
              IO.renameFile fp filepath `catch` exdev
        Nothing ->
          L8.interact
            (either error S.toLazyByteString . reformat style (Just exts) . L8.toStrict)
    Failed (Wrap (Stopped Version) _) ->
      putStrLn ("hindent " ++ showVersion version)
    Failed (Wrap (Stopped Help) _) -> putStrLn (help defaultConfig)
    _ -> error (help defaultConfig)

-- | Read config from a config file, or return 'defaultConfig'.
getConfig :: IO Config
getConfig = do
  cur <- Path.getCurrentDir
  homeDir <- Path.getHomeDir
  mfile <-
    Path.findFileUp cur ((== ".hindent.yaml") . toFilePath . filename) (Just homeDir)
  case mfile of
    Nothing -> return defaultConfig
    Just file -> do
      result <- Y.decodeFileEither (toFilePath file)
      case result of
        Left e -> error (show e)
        Right config -> return config

-- | Help text.
help :: Config -> String
help config =
  "hindent " ++
  T.unpack (textDescription (describe (options config) [])) ++
  "\nVersion " ++
  showVersion version ++
  "\n" ++
  "Default --indent-size is 2. Specify --indent-size 4 if you prefer that.\n" ++
  "-X to pass extensions e.g. -XMagicHash etc.\n" ++
  "The --style option is now ignored, but preserved for backwards-compatibility.\n" ++
  "Johan Tibell is the default and only style."

-- | Options that stop the argument parser.
data Stoppers
  = Version
  | Help
   deriving (Show)

-- | Program options.
options
  :: Monad m
  => Config -> Consumer [Text] (Option Stoppers) m (Config, [Extension], Maybe FilePath)
options config = ver *> ((,,) <$> style <*> exts <*> file)
  where
    ver =
      stop (flag "version" "Print the version" Version) *>
      stop (flag "help" "Show help" Help)
    style =
      makeStyle <$>
      fmap
        (const config)
        (optional
           (constant "--style" "Style to print with" () *> anyString "STYLE")) <*>
      lineLen <*>
      indentSpaces <*>
      trailingNewline
    exts = fmap getExtensions (many (prefix "X" "Language extension"))
    indentSpaces =
      fmap
        (>>= (readMaybe . T.unpack))
        (optional
           (arg "indent-size" "Indentation size in spaces, default: 4" <|>
            arg "tab-size" "Same as --indent-size, for compatibility"))
    lineLen =
      fmap
        (>>= (readMaybe . T.unpack))
        (optional (arg "line-length" "Desired length of lines"))
    trailingNewline =
      optional
        (constant "--no-force-newline" "Don't force a trailing newline" False)
    makeStyle s mlen tabs trailing =
      s
      { configMaxColumns = fromMaybe (configMaxColumns s) mlen
      , configIndentSpaces = fromMaybe (configIndentSpaces s) tabs
      , configTrailingNewline = fromMaybe (configTrailingNewline s) trailing
      }
    file = fmap (fmap T.unpack) (optional (anyString "[<filename>]"))