module Language.Haskell.Format.HIndent
  ( autoSettings
  , formatter
  , defaultFormatter
  ) where

import           Data.ByteString.Builder
import           Data.ByteString.Lazy             as L
import qualified Data.Text                        as Text
import           Data.Text.Encoding               as Encoding
import qualified Data.Yaml                        as Y
import           HIndent
import           HIndent.Types
import           Language.Haskell.Exts.Extension  (Extension)
import           Path
import qualified Path.Find                        as Path
import qualified Path.IO                          as Path

import           Language.Haskell.Format.Internal
import           Language.Haskell.Format.Types

data Settings =
  Settings Config (Maybe [Extension])

defaultFormatter :: IO Formatter
defaultFormatter :: IO Formatter
defaultFormatter = Settings -> Formatter
formatter (Settings -> Formatter) -> IO Settings -> IO Formatter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Settings
autoSettings

autoSettings :: IO Settings
autoSettings :: IO Settings
autoSettings = do
  Config
config <- IO Config
getConfig
  Settings -> IO Settings
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings -> IO Settings) -> Settings -> IO Settings
forall a b. (a -> b) -> a -> b
$ Config -> Maybe [Extension] -> Settings
Settings Config
config (Maybe [Extension] -> Settings) -> Maybe [Extension] -> Settings
forall a b. (a -> b) -> a -> b
$ [Extension] -> Maybe [Extension]
forall a. a -> Maybe a
Just [Extension]
defaultExtensions

-- | Read config from a config file, or return 'defaultConfig'.
getConfig :: IO Config
getConfig :: IO Config
getConfig = do
  Path Abs Dir
cur <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.getCurrentDir
  Path Abs Dir
homeDir <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.getHomeDir
  Maybe (Path Abs File)
mfile <-
    Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> IO (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
Path.findFileUp
      Path Abs Dir
cur
      (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".hindent.yaml") ([Char] -> Bool)
-> (Path Abs File -> [Char]) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Rel File -> [Char])
-> (Path Abs File -> Path Rel File) -> Path Abs File -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename)
      (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
homeDir)
  case Maybe (Path Abs File)
mfile of
    Maybe (Path Abs File)
Nothing -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig
    Just Path Abs File
file -> do
      Either ParseException Config
result <- [Char] -> IO (Either ParseException Config)
forall a. FromJSON a => [Char] -> IO (Either ParseException a)
Y.decodeFileEither (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
file)
      case Either ParseException Config
result of
        Left ParseException
e       -> [Char] -> IO Config
forall a. HasCallStack => [Char] -> a
error (ParseException -> [Char]
forall a. Show a => a -> [Char]
show ParseException
e)
        Right Config
config -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config

formatter :: Settings -> Formatter
formatter :: Settings -> Formatter
formatter = (HaskellSource -> Either [Char] HaskellSource) -> Formatter
mkFormatter ((HaskellSource -> Either [Char] HaskellSource) -> Formatter)
-> (Settings -> HaskellSource -> Either [Char] HaskellSource)
-> Settings
-> Formatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> HaskellSource -> Either [Char] HaskellSource
hindent

hindent :: Settings -> HaskellSource -> Either String HaskellSource
hindent :: Settings -> HaskellSource -> Either [Char] HaskellSource
hindent (Settings Config
config Maybe [Extension]
extensions) (HaskellSource [Char]
filepath [Char]
source) =
  [Char] -> [Char] -> HaskellSource
HaskellSource [Char]
filepath ([Char] -> HaskellSource)
-> (Builder -> [Char]) -> Builder -> HaskellSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Char]
unpackBuilder (Builder -> HaskellSource)
-> Either [Char] Builder -> Either [Char] HaskellSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Config
-> Maybe [Extension]
-> Maybe [Char]
-> ByteString
-> Either [Char] Builder
reformat Config
config Maybe [Extension]
extensions Maybe [Char]
forall a. Maybe a
Nothing ByteString
sourceText
  where
    sourceText :: ByteString
sourceText = Text -> ByteString
Encoding.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
source
    unpackBuilder :: Builder -> [Char]
unpackBuilder =
      Text -> [Char]
Text.unpack (Text -> [Char]) -> (Builder -> Text) -> Builder -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Encoding.decodeUtf8 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString