{-# LANGUAGE OverloadedStrings #-}

module Stack.Ghci.Script
  ( GhciScript
  , ModuleName

  , cmdAdd
  , cmdAddFile
  , cmdCdGhc
  , cmdModule

  , scriptToLazyByteString
  , scriptToBuilder
  , scriptToFile
  ) where

import           Control.Applicative
import           Data.ByteString.Lazy (ByteString)
import           Data.ByteString.Builder
import           Data.Monoid
import           Data.List
import           Data.Set (Set)
import qualified Data.Set as S
import           Data.Text (Text)
import           Data.Text.Encoding (encodeUtf8Builder)
import           Path
import           Prelude -- Fix redundant imports warnings
import           System.IO

import           Distribution.ModuleName hiding (toFilePath)

newtype GhciScript = GhciScript { unGhciScript :: [GhciCommand] }

instance Monoid GhciScript where
  mempty = GhciScript []
  (GhciScript xs) `mappend` (GhciScript ys) = GhciScript (ys <> xs)

data GhciCommand
  = Add (Set ModuleName)
  | AddFile (Path Abs File)
  | CdGhc (Path Abs Dir)
  | Module (Set ModuleName)
  deriving (Show)

cmdAdd :: Set ModuleName -> GhciScript
cmdAdd = GhciScript . (:[]) . Add

cmdAddFile :: Path Abs File -> GhciScript
cmdAddFile = GhciScript . (:[]) . AddFile

cmdCdGhc :: Path Abs Dir -> GhciScript
cmdCdGhc = GhciScript . (:[]) . CdGhc

cmdModule :: Set ModuleName -> GhciScript
cmdModule = GhciScript . (:[]) . Module

scriptToLazyByteString :: GhciScript -> ByteString
scriptToLazyByteString = toLazyByteString . scriptToBuilder

scriptToBuilder :: GhciScript -> Builder
scriptToBuilder backwardScript = mconcat $ fmap commandToBuilder script
  where
    script = reverse $ unGhciScript backwardScript

scriptToFile :: Path Abs File -> GhciScript -> IO ()
scriptToFile path script =
  withFile filepath WriteMode
    $ \hdl -> do hSetBuffering hdl (BlockBuffering Nothing)
                 hSetBinaryMode hdl True
                 hPutBuilder hdl (scriptToBuilder script)
  where
    filepath = toFilePath path

-- Command conversion

fromText :: Text -> Builder
fromText = encodeUtf8Builder

commandToBuilder :: GhciCommand -> Builder

commandToBuilder (Add modules)
  | S.null modules = mempty
  | otherwise      =
       fromText ":add "
    <> mconcat (intersperse (fromText " ")
        $ (stringUtf8 . quoteFileName . mconcat . intersperse "." . components) <$> S.toAscList modules)
    <> fromText "\n"

commandToBuilder (AddFile path) =
  fromText ":add " <> stringUtf8 (quoteFileName (toFilePath path)) <> fromText "\n"

commandToBuilder (CdGhc path) =
  fromText ":cd-ghc " <> stringUtf8 (quoteFileName (toFilePath path)) <> fromText "\n"

commandToBuilder (Module modules)
  | S.null modules = fromText ":module +\n"
  | otherwise      =
       fromText ":module + "
    <> mconcat (intersperse (fromText " ")
        $ (stringUtf8 . quoteFileName . mconcat . intersperse "." . components) <$> S.toAscList modules)
    <> fromText "\n"

-- | Make sure that a filename with spaces in it gets the proper quotes.
quoteFileName :: String -> String
quoteFileName x = if ' ' `elem` x then show x else x