{-# LANGUAGE OverloadedStrings, CPP, TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, TypeFamilies, ConstraintKinds, TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Server.Types (
	ServerMonadBase,
	SessionLog(..), Session(..), SessionMonad(..), askSession, ServerM(..),
	CommandOptions(..), CommandMonad(..), askOptions, ClientM(..),
	withSession, serverListen, serverSetLogLevel, serverWait, serverWaitClients,
	serverSqlDatabase, openSqlConnection, closeSqlConnection, withSqlConnection, withSqlTransaction, serverSetFileContents,
	inSessionGhc, inSessionUpdater, postSessionUpdater, serverExit, commandRoot, commandNotify, commandLink, commandHold,
	ServerCommand(..), ConnectionPort(..), ServerOpts(..), silentOpts, ClientOpts(..), serverOptsArgs, Request(..),

	Command(..),
	FileSource(..), TargetFilter(..), SearchQuery(..), SearchType(..),
	FromCmd(..),
	) where

import Control.Applicative
import Control.Concurrent.Async (Async)
import qualified Control.Concurrent.FiniteChan as F
import Control.Lens (view, set)
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Fail
import Control.Monad.Morph
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Trans.Control
import Data.Aeson hiding (Result(..), Error)
import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Default
import Data.Maybe (fromMaybe)
import Data.Foldable (asum)
import Data.Text (Text)
import Data.String (fromString)
import qualified Database.SQLite.Simple as SQL
import qualified Network.HTTP.Client as HTTP
import Options.Applicative
import System.Log.Simple as Log

import Control.Concurrent.Worker
import Data.LookupTable
import System.Directory.Paths
import Text.Format (Formattable(..), (~~))

import HsDev.Error (hsdevError)
import HsDev.Inspect.Types
import HsDev.Server.Message
import HsDev.Watcher.Types (Watcher)
import HsDev.PackageDb.Types
import HsDev.Project.Types
import HsDev.Tools.Ghc.Worker (GhcWorker, GhcM)
import HsDev.Tools.Types (Note, OutputMessage)
import HsDev.Tools.AutoFix (Refact)
import HsDev.Types (HsDevError(..))
import HsDev.Util

#if mingw32_HOST_OS
import System.Win32.FileMapping.NamePool (Pool)
#endif

type ServerMonadBase m = (MonadIO m, MonadFail m, MonadMask m, MonadBaseControl IO m, Alternative m, MonadPlus m)

data SessionLog = SessionLog {
	SessionLog -> Log
sessionLogger :: Log,
	SessionLog -> IO [Message]
sessionListenLog :: IO [Log.Message],
	SessionLog -> IO ()
sessionLogWait :: IO () }

data Session = Session {
	Session -> Connection
sessionSqlDatabase :: SQL.Connection,
	Session -> String
sessionSqlPath :: String,
	Session -> SessionLog
sessionLog :: SessionLog,
	Session -> Maybe Watcher
sessionWatcher :: Maybe Watcher,
	Session -> Path -> Maybe Path -> IO ()
sessionFileContents :: Path -> Maybe Text -> IO (),
#if mingw32_HOST_OS
	sessionMmapPool :: Maybe Pool,
#endif
	Session -> GhcWorker
sessionGhc :: GhcWorker,
	Session -> Worker (ServerM IO)
sessionUpdater :: Worker (ServerM IO),
	Session -> LookupTable (Maybe Path) (Environment, FixitiesTable)
sessionResolveEnvironment :: LookupTable (Maybe Path) (Environment, FixitiesTable),
	Session -> Manager
sessionHTTPManager :: HTTP.Manager,
	Session -> IO ()
sessionExit :: IO (),
	Session -> IO ()
sessionWait :: IO (),
	Session -> Chan (IO ())
sessionClients :: F.Chan (IO ()),
	Session -> [(String, String)]
sessionDefines :: [(String, String)] }

class (ServerMonadBase m, MonadLog m) => SessionMonad m where
	getSession :: m Session
	localSession :: (Session -> Session) -> m a -> m a

askSession :: SessionMonad m => (Session -> a) -> m a
askSession :: (Session -> a) -> m a
askSession Session -> a
f = (Session -> a) -> m Session -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Session -> a
f m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession

newtype ServerM m a = ServerM { ServerM m a -> ReaderT Session m a
runServerM :: ReaderT Session m a }
	deriving (a -> ServerM m b -> ServerM m a
(a -> b) -> ServerM m a -> ServerM m b
(forall a b. (a -> b) -> ServerM m a -> ServerM m b)
-> (forall a b. a -> ServerM m b -> ServerM m a)
-> Functor (ServerM m)
forall a b. a -> ServerM m b -> ServerM m a
forall a b. (a -> b) -> ServerM m a -> ServerM m b
forall (m :: * -> *) a b.
Functor m =>
a -> ServerM m b -> ServerM m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ServerM m a -> ServerM m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ServerM m b -> ServerM m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ServerM m b -> ServerM m a
fmap :: (a -> b) -> ServerM m a -> ServerM m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ServerM m a -> ServerM m b
Functor, Functor (ServerM m)
a -> ServerM m a
Functor (ServerM m)
-> (forall a. a -> ServerM m a)
-> (forall a b. ServerM m (a -> b) -> ServerM m a -> ServerM m b)
-> (forall a b c.
    (a -> b -> c) -> ServerM m a -> ServerM m b -> ServerM m c)
-> (forall a b. ServerM m a -> ServerM m b -> ServerM m b)
-> (forall a b. ServerM m a -> ServerM m b -> ServerM m a)
-> Applicative (ServerM m)
ServerM m a -> ServerM m b -> ServerM m b
ServerM m a -> ServerM m b -> ServerM m a
ServerM m (a -> b) -> ServerM m a -> ServerM m b
(a -> b -> c) -> ServerM m a -> ServerM m b -> ServerM m c
forall a. a -> ServerM m a
forall a b. ServerM m a -> ServerM m b -> ServerM m a
forall a b. ServerM m a -> ServerM m b -> ServerM m b
forall a b. ServerM m (a -> b) -> ServerM m a -> ServerM m b
forall a b c.
(a -> b -> c) -> ServerM m a -> ServerM m b -> ServerM m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (ServerM m)
forall (m :: * -> *) a. Applicative m => a -> ServerM m a
forall (m :: * -> *) a b.
Applicative m =>
ServerM m a -> ServerM m b -> ServerM m a
forall (m :: * -> *) a b.
Applicative m =>
ServerM m a -> ServerM m b -> ServerM m b
forall (m :: * -> *) a b.
Applicative m =>
ServerM m (a -> b) -> ServerM m a -> ServerM m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ServerM m a -> ServerM m b -> ServerM m c
<* :: ServerM m a -> ServerM m b -> ServerM m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
ServerM m a -> ServerM m b -> ServerM m a
*> :: ServerM m a -> ServerM m b -> ServerM m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
ServerM m a -> ServerM m b -> ServerM m b
liftA2 :: (a -> b -> c) -> ServerM m a -> ServerM m b -> ServerM m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ServerM m a -> ServerM m b -> ServerM m c
<*> :: ServerM m (a -> b) -> ServerM m a -> ServerM m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
ServerM m (a -> b) -> ServerM m a -> ServerM m b
pure :: a -> ServerM m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> ServerM m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (ServerM m)
Applicative, Applicative (ServerM m)
ServerM m a
Applicative (ServerM m)
-> (forall a. ServerM m a)
-> (forall a. ServerM m a -> ServerM m a -> ServerM m a)
-> (forall a. ServerM m a -> ServerM m [a])
-> (forall a. ServerM m a -> ServerM m [a])
-> Alternative (ServerM m)
ServerM m a -> ServerM m a -> ServerM m a
ServerM m a -> ServerM m [a]
ServerM m a -> ServerM m [a]
forall a. ServerM m a
forall a. ServerM m a -> ServerM m [a]
forall a. ServerM m a -> ServerM m a -> ServerM m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (ServerM m)
forall (m :: * -> *) a. Alternative m => ServerM m a
forall (m :: * -> *) a.
Alternative m =>
ServerM m a -> ServerM m [a]
forall (m :: * -> *) a.
Alternative m =>
ServerM m a -> ServerM m a -> ServerM m a
many :: ServerM m a -> ServerM m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
ServerM m a -> ServerM m [a]
some :: ServerM m a -> ServerM m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
ServerM m a -> ServerM m [a]
<|> :: ServerM m a -> ServerM m a -> ServerM m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
ServerM m a -> ServerM m a -> ServerM m a
empty :: ServerM m a
$cempty :: forall (m :: * -> *) a. Alternative m => ServerM m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (ServerM m)
Alternative, Applicative (ServerM m)
a -> ServerM m a
Applicative (ServerM m)
-> (forall a b. ServerM m a -> (a -> ServerM m b) -> ServerM m b)
-> (forall a b. ServerM m a -> ServerM m b -> ServerM m b)
-> (forall a. a -> ServerM m a)
-> Monad (ServerM m)
ServerM m a -> (a -> ServerM m b) -> ServerM m b
ServerM m a -> ServerM m b -> ServerM m b
forall a. a -> ServerM m a
forall a b. ServerM m a -> ServerM m b -> ServerM m b
forall a b. ServerM m a -> (a -> ServerM m b) -> ServerM m b
forall (m :: * -> *). Monad m => Applicative (ServerM m)
forall (m :: * -> *) a. Monad m => a -> ServerM m a
forall (m :: * -> *) a b.
Monad m =>
ServerM m a -> ServerM m b -> ServerM m b
forall (m :: * -> *) a b.
Monad m =>
ServerM m a -> (a -> ServerM m b) -> ServerM m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ServerM m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ServerM m a
>> :: ServerM m a -> ServerM m b -> ServerM m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ServerM m a -> ServerM m b -> ServerM m b
>>= :: ServerM m a -> (a -> ServerM m b) -> ServerM m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ServerM m a -> (a -> ServerM m b) -> ServerM m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (ServerM m)
Monad, Monad (ServerM m)
Monad (ServerM m)
-> (forall a. String -> ServerM m a) -> MonadFail (ServerM m)
String -> ServerM m a
forall a. String -> ServerM m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (ServerM m)
forall (m :: * -> *) a. MonadFail m => String -> ServerM m a
fail :: String -> ServerM m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> ServerM m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (ServerM m)
MonadFail, Monad (ServerM m)
Alternative (ServerM m)
ServerM m a
Alternative (ServerM m)
-> Monad (ServerM m)
-> (forall a. ServerM m a)
-> (forall a. ServerM m a -> ServerM m a -> ServerM m a)
-> MonadPlus (ServerM m)
ServerM m a -> ServerM m a -> ServerM m a
forall a. ServerM m a
forall a. ServerM m a -> ServerM m a -> ServerM m a
forall (m :: * -> *). MonadPlus m => Monad (ServerM m)
forall (m :: * -> *). MonadPlus m => Alternative (ServerM m)
forall (m :: * -> *) a. MonadPlus m => ServerM m a
forall (m :: * -> *) a.
MonadPlus m =>
ServerM m a -> ServerM m a -> ServerM m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ServerM m a -> ServerM m a -> ServerM m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
ServerM m a -> ServerM m a -> ServerM m a
mzero :: ServerM m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => ServerM m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (ServerM m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (ServerM m)
MonadPlus, Monad (ServerM m)
Monad (ServerM m)
-> (forall a. IO a -> ServerM m a) -> MonadIO (ServerM m)
IO a -> ServerM m a
forall a. IO a -> ServerM m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (ServerM m)
forall (m :: * -> *) a. MonadIO m => IO a -> ServerM m a
liftIO :: IO a -> ServerM m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ServerM m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (ServerM m)
MonadIO, MonadReader Session, m a -> ServerM m a
(forall (m :: * -> *) a. Monad m => m a -> ServerM m a)
-> MonadTrans ServerM
forall (m :: * -> *) a. Monad m => m a -> ServerM m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ServerM m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ServerM m a
MonadTrans, Monad (ServerM m)
e -> ServerM m a
Monad (ServerM m)
-> (forall e a. Exception e => e -> ServerM m a)
-> MonadThrow (ServerM m)
forall e a. Exception e => e -> ServerM m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (ServerM m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ServerM m a
throwM :: e -> ServerM m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ServerM m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (ServerM m)
MonadThrow, MonadThrow (ServerM m)
MonadThrow (ServerM m)
-> (forall e a.
    Exception e =>
    ServerM m a -> (e -> ServerM m a) -> ServerM m a)
-> MonadCatch (ServerM m)
ServerM m a -> (e -> ServerM m a) -> ServerM m a
forall e a.
Exception e =>
ServerM m a -> (e -> ServerM m a) -> ServerM m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (ServerM m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ServerM m a -> (e -> ServerM m a) -> ServerM m a
catch :: ServerM m a -> (e -> ServerM m a) -> ServerM m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ServerM m a -> (e -> ServerM m a) -> ServerM m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (ServerM m)
MonadCatch, MonadCatch (ServerM m)
MonadCatch (ServerM m)
-> (forall b.
    ((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
    -> ServerM m b)
-> (forall b.
    ((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
    -> ServerM m b)
-> (forall a b c.
    ServerM m a
    -> (a -> ExitCase b -> ServerM m c)
    -> (a -> ServerM m b)
    -> ServerM m (b, c))
-> MonadMask (ServerM m)
ServerM m a
-> (a -> ExitCase b -> ServerM m c)
-> (a -> ServerM m b)
-> ServerM m (b, c)
((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
forall b.
((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
forall a b c.
ServerM m a
-> (a -> ExitCase b -> ServerM m c)
-> (a -> ServerM m b)
-> ServerM m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (ServerM m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
forall (m :: * -> *) a b c.
MonadMask m =>
ServerM m a
-> (a -> ExitCase b -> ServerM m c)
-> (a -> ServerM m b)
-> ServerM m (b, c)
generalBracket :: ServerM m a
-> (a -> ExitCase b -> ServerM m c)
-> (a -> ServerM m b)
-> ServerM m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
ServerM m a
-> (a -> ExitCase b -> ServerM m c)
-> (a -> ServerM m b)
-> ServerM m (b, c)
uninterruptibleMask :: ((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
mask :: ((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. ServerM m a -> ServerM m a) -> ServerM m b)
-> ServerM m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (ServerM m)
MonadMask)

instance (MonadIO m, MonadMask m) => MonadLog (ServerM m) where
	askLog :: ServerM m Log
askLog = ReaderT Session m Log -> ServerM m Log
forall (m :: * -> *) a. ReaderT Session m a -> ServerM m a
ServerM (ReaderT Session m Log -> ServerM m Log)
-> ReaderT Session m Log -> ServerM m Log
forall a b. (a -> b) -> a -> b
$ (Session -> Log) -> ReaderT Session m Log
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (SessionLog -> Log
sessionLogger (SessionLog -> Log) -> (Session -> SessionLog) -> Session -> Log
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> SessionLog
sessionLog)
	localLog :: (Log -> Log) -> ServerM m a -> ServerM m a
localLog Log -> Log
fn = ReaderT Session m a -> ServerM m a
forall (m :: * -> *) a. ReaderT Session m a -> ServerM m a
ServerM (ReaderT Session m a -> ServerM m a)
-> (ServerM m a -> ReaderT Session m a)
-> ServerM m a
-> ServerM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> Session) -> ReaderT Session m a -> ReaderT Session m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Session -> Session
setLog' (ReaderT Session m a -> ReaderT Session m a)
-> (ServerM m a -> ReaderT Session m a)
-> ServerM m a
-> ReaderT Session m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerM m a -> ReaderT Session m a
forall (m :: * -> *) a. ServerM m a -> ReaderT Session m a
runServerM where
		setLog' :: Session -> Session
setLog' Session
sess = Session
sess { sessionLog :: SessionLog
sessionLog = (Session -> SessionLog
sessionLog Session
sess) { sessionLogger :: Log
sessionLogger = Log -> Log
fn (SessionLog -> Log
sessionLogger (Session -> SessionLog
sessionLog Session
sess)) } }

instance ServerMonadBase m => SessionMonad (ServerM m) where
	getSession :: ServerM m Session
getSession = ServerM m Session
forall r (m :: * -> *). MonadReader r m => m r
ask
	localSession :: (Session -> Session) -> ServerM m a -> ServerM m a
localSession = (Session -> Session) -> ServerM m a -> ServerM m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local

instance MonadBase b m => MonadBase b (ServerM m) where
	liftBase :: b α -> ServerM m α
liftBase = ReaderT Session m α -> ServerM m α
forall (m :: * -> *) a. ReaderT Session m a -> ServerM m a
ServerM (ReaderT Session m α -> ServerM m α)
-> (b α -> ReaderT Session m α) -> b α -> ServerM m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> ReaderT Session m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadBaseControl b m => MonadBaseControl b (ServerM m) where
	type StM (ServerM m) a = StM (ReaderT Session m) a
	liftBaseWith :: (RunInBase (ServerM m) b -> b a) -> ServerM m a
liftBaseWith RunInBase (ServerM m) b -> b a
f = ReaderT Session m a -> ServerM m a
forall (m :: * -> *) a. ReaderT Session m a -> ServerM m a
ServerM (ReaderT Session m a -> ServerM m a)
-> ReaderT Session m a -> ServerM m a
forall a b. (a -> b) -> a -> b
$ (RunInBase (ReaderT Session m) b -> b a) -> ReaderT Session m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase (ReaderT Session m) b
f' -> RunInBase (ServerM m) b -> b a
f (ReaderT Session m a -> b (StM m a)
RunInBase (ReaderT Session m) b
f' (ReaderT Session m a -> b (StM m a))
-> (ServerM m a -> ReaderT Session m a)
-> ServerM m a
-> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerM m a -> ReaderT Session m a
forall (m :: * -> *) a. ServerM m a -> ReaderT Session m a
runServerM))
	restoreM :: StM (ServerM m) a -> ServerM m a
restoreM = ReaderT Session m a -> ServerM m a
forall (m :: * -> *) a. ReaderT Session m a -> ServerM m a
ServerM (ReaderT Session m a -> ServerM m a)
-> (StM m a -> ReaderT Session m a) -> StM m a -> ServerM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> ReaderT Session m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

instance MFunctor ServerM where
	hoist :: (forall a. m a -> n a) -> ServerM m b -> ServerM n b
hoist forall a. m a -> n a
fn = ReaderT Session n b -> ServerM n b
forall (m :: * -> *) a. ReaderT Session m a -> ServerM m a
ServerM (ReaderT Session n b -> ServerM n b)
-> (ServerM m b -> ReaderT Session n b)
-> ServerM m b
-> ServerM n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> n a)
-> ReaderT Session m b -> ReaderT Session n b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
fn (ReaderT Session m b -> ReaderT Session n b)
-> (ServerM m b -> ReaderT Session m b)
-> ServerM m b
-> ReaderT Session n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerM m b -> ReaderT Session m b
forall (m :: * -> *) a. ServerM m a -> ReaderT Session m a
runServerM

instance SessionMonad m => SessionMonad (ReaderT r m) where
	getSession :: ReaderT r m Session
getSession = m Session -> ReaderT r m Session
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
	localSession :: (Session -> Session) -> ReaderT r m a -> ReaderT r m a
localSession = (m a -> m a) -> ReaderT r m a -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m a -> m a) -> ReaderT r m a -> ReaderT r m a)
-> ((Session -> Session) -> m a -> m a)
-> (Session -> Session)
-> ReaderT r m a
-> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> Session) -> m a -> m a
forall (m :: * -> *) a.
SessionMonad m =>
(Session -> Session) -> m a -> m a
localSession

instance (SessionMonad m, Monoid w) => SessionMonad (WriterT w m) where
	getSession :: WriterT w m Session
getSession = m Session -> WriterT w m Session
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
	localSession :: (Session -> Session) -> WriterT w m a -> WriterT w m a
localSession = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT ((m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a)
-> ((Session -> Session) -> m (a, w) -> m (a, w))
-> (Session -> Session)
-> WriterT w m a
-> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> Session) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a.
SessionMonad m =>
(Session -> Session) -> m a -> m a
localSession

instance SessionMonad m => SessionMonad (StateT s m) where
	getSession :: StateT s m Session
getSession = m Session -> StateT s m Session
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
	localSession :: (Session -> Session) -> StateT s m a -> StateT s m a
localSession = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a)
-> ((Session -> Session) -> m (a, s) -> m (a, s))
-> (Session -> Session)
-> StateT s m a
-> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> Session) -> m (a, s) -> m (a, s)
forall (m :: * -> *) a.
SessionMonad m =>
(Session -> Session) -> m a -> m a
localSession

data CommandOptions = CommandOptions {
	CommandOptions -> String
commandOptionsRoot :: FilePath,
	CommandOptions -> Notification -> IO ()
commandOptionsNotify :: Notification -> IO (),
	CommandOptions -> IO ()
commandOptionsLink :: IO (),
	CommandOptions -> IO ()
commandOptionsHold :: IO () }

instance Default CommandOptions where
	def :: CommandOptions
def = String
-> (Notification -> IO ()) -> IO () -> IO () -> CommandOptions
CommandOptions String
"." (IO () -> Notification -> IO ()
forall a b. a -> b -> a
const (IO () -> Notification -> IO ()) -> IO () -> Notification -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

class (SessionMonad m, MonadPlus m) => CommandMonad m where
	getOptions :: m CommandOptions

askOptions :: CommandMonad m => (CommandOptions -> a) -> m a
askOptions :: (CommandOptions -> a) -> m a
askOptions CommandOptions -> a
f = (CommandOptions -> a) -> m CommandOptions -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CommandOptions -> a
f m CommandOptions
forall (m :: * -> *). CommandMonad m => m CommandOptions
getOptions

newtype ClientM m a = ClientM { ClientM m a -> ServerM (ReaderT CommandOptions m) a
runClientM :: ServerM (ReaderT CommandOptions m) a }
	deriving (a -> ClientM m b -> ClientM m a
(a -> b) -> ClientM m a -> ClientM m b
(forall a b. (a -> b) -> ClientM m a -> ClientM m b)
-> (forall a b. a -> ClientM m b -> ClientM m a)
-> Functor (ClientM m)
forall a b. a -> ClientM m b -> ClientM m a
forall a b. (a -> b) -> ClientM m a -> ClientM m b
forall (m :: * -> *) a b.
Functor m =>
a -> ClientM m b -> ClientM m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ClientM m a -> ClientM m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ClientM m b -> ClientM m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ClientM m b -> ClientM m a
fmap :: (a -> b) -> ClientM m a -> ClientM m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ClientM m a -> ClientM m b
Functor, Functor (ClientM m)
a -> ClientM m a
Functor (ClientM m)
-> (forall a. a -> ClientM m a)
-> (forall a b. ClientM m (a -> b) -> ClientM m a -> ClientM m b)
-> (forall a b c.
    (a -> b -> c) -> ClientM m a -> ClientM m b -> ClientM m c)
-> (forall a b. ClientM m a -> ClientM m b -> ClientM m b)
-> (forall a b. ClientM m a -> ClientM m b -> ClientM m a)
-> Applicative (ClientM m)
ClientM m a -> ClientM m b -> ClientM m b
ClientM m a -> ClientM m b -> ClientM m a
ClientM m (a -> b) -> ClientM m a -> ClientM m b
(a -> b -> c) -> ClientM m a -> ClientM m b -> ClientM m c
forall a. a -> ClientM m a
forall a b. ClientM m a -> ClientM m b -> ClientM m a
forall a b. ClientM m a -> ClientM m b -> ClientM m b
forall a b. ClientM m (a -> b) -> ClientM m a -> ClientM m b
forall a b c.
(a -> b -> c) -> ClientM m a -> ClientM m b -> ClientM m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (ClientM m)
forall (m :: * -> *) a. Applicative m => a -> ClientM m a
forall (m :: * -> *) a b.
Applicative m =>
ClientM m a -> ClientM m b -> ClientM m a
forall (m :: * -> *) a b.
Applicative m =>
ClientM m a -> ClientM m b -> ClientM m b
forall (m :: * -> *) a b.
Applicative m =>
ClientM m (a -> b) -> ClientM m a -> ClientM m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ClientM m a -> ClientM m b -> ClientM m c
<* :: ClientM m a -> ClientM m b -> ClientM m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
ClientM m a -> ClientM m b -> ClientM m a
*> :: ClientM m a -> ClientM m b -> ClientM m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
ClientM m a -> ClientM m b -> ClientM m b
liftA2 :: (a -> b -> c) -> ClientM m a -> ClientM m b -> ClientM m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ClientM m a -> ClientM m b -> ClientM m c
<*> :: ClientM m (a -> b) -> ClientM m a -> ClientM m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
ClientM m (a -> b) -> ClientM m a -> ClientM m b
pure :: a -> ClientM m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> ClientM m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (ClientM m)
Applicative, Applicative (ClientM m)
ClientM m a
Applicative (ClientM m)
-> (forall a. ClientM m a)
-> (forall a. ClientM m a -> ClientM m a -> ClientM m a)
-> (forall a. ClientM m a -> ClientM m [a])
-> (forall a. ClientM m a -> ClientM m [a])
-> Alternative (ClientM m)
ClientM m a -> ClientM m a -> ClientM m a
ClientM m a -> ClientM m [a]
ClientM m a -> ClientM m [a]
forall a. ClientM m a
forall a. ClientM m a -> ClientM m [a]
forall a. ClientM m a -> ClientM m a -> ClientM m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (ClientM m)
forall (m :: * -> *) a. Alternative m => ClientM m a
forall (m :: * -> *) a.
Alternative m =>
ClientM m a -> ClientM m [a]
forall (m :: * -> *) a.
Alternative m =>
ClientM m a -> ClientM m a -> ClientM m a
many :: ClientM m a -> ClientM m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
ClientM m a -> ClientM m [a]
some :: ClientM m a -> ClientM m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
ClientM m a -> ClientM m [a]
<|> :: ClientM m a -> ClientM m a -> ClientM m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
ClientM m a -> ClientM m a -> ClientM m a
empty :: ClientM m a
$cempty :: forall (m :: * -> *) a. Alternative m => ClientM m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (ClientM m)
Alternative, Applicative (ClientM m)
a -> ClientM m a
Applicative (ClientM m)
-> (forall a b. ClientM m a -> (a -> ClientM m b) -> ClientM m b)
-> (forall a b. ClientM m a -> ClientM m b -> ClientM m b)
-> (forall a. a -> ClientM m a)
-> Monad (ClientM m)
ClientM m a -> (a -> ClientM m b) -> ClientM m b
ClientM m a -> ClientM m b -> ClientM m b
forall a. a -> ClientM m a
forall a b. ClientM m a -> ClientM m b -> ClientM m b
forall a b. ClientM m a -> (a -> ClientM m b) -> ClientM m b
forall (m :: * -> *). Monad m => Applicative (ClientM m)
forall (m :: * -> *) a. Monad m => a -> ClientM m a
forall (m :: * -> *) a b.
Monad m =>
ClientM m a -> ClientM m b -> ClientM m b
forall (m :: * -> *) a b.
Monad m =>
ClientM m a -> (a -> ClientM m b) -> ClientM m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ClientM m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ClientM m a
>> :: ClientM m a -> ClientM m b -> ClientM m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ClientM m a -> ClientM m b -> ClientM m b
>>= :: ClientM m a -> (a -> ClientM m b) -> ClientM m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ClientM m a -> (a -> ClientM m b) -> ClientM m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (ClientM m)
Monad, Monad (ClientM m)
Monad (ClientM m)
-> (forall a. String -> ClientM m a) -> MonadFail (ClientM m)
String -> ClientM m a
forall a. String -> ClientM m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (ClientM m)
forall (m :: * -> *) a. MonadFail m => String -> ClientM m a
fail :: String -> ClientM m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> ClientM m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (ClientM m)
MonadFail, Monad (ClientM m)
Alternative (ClientM m)
ClientM m a
Alternative (ClientM m)
-> Monad (ClientM m)
-> (forall a. ClientM m a)
-> (forall a. ClientM m a -> ClientM m a -> ClientM m a)
-> MonadPlus (ClientM m)
ClientM m a -> ClientM m a -> ClientM m a
forall a. ClientM m a
forall a. ClientM m a -> ClientM m a -> ClientM m a
forall (m :: * -> *). MonadPlus m => Monad (ClientM m)
forall (m :: * -> *). MonadPlus m => Alternative (ClientM m)
forall (m :: * -> *) a. MonadPlus m => ClientM m a
forall (m :: * -> *) a.
MonadPlus m =>
ClientM m a -> ClientM m a -> ClientM m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ClientM m a -> ClientM m a -> ClientM m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
ClientM m a -> ClientM m a -> ClientM m a
mzero :: ClientM m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => ClientM m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (ClientM m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (ClientM m)
MonadPlus, Monad (ClientM m)
Monad (ClientM m)
-> (forall a. IO a -> ClientM m a) -> MonadIO (ClientM m)
IO a -> ClientM m a
forall a. IO a -> ClientM m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (ClientM m)
forall (m :: * -> *) a. MonadIO m => IO a -> ClientM m a
liftIO :: IO a -> ClientM m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ClientM m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (ClientM m)
MonadIO, Monad (ClientM m)
e -> ClientM m a
Monad (ClientM m)
-> (forall e a. Exception e => e -> ClientM m a)
-> MonadThrow (ClientM m)
forall e a. Exception e => e -> ClientM m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (ClientM m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ClientM m a
throwM :: e -> ClientM m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ClientM m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (ClientM m)
MonadThrow, MonadThrow (ClientM m)
MonadThrow (ClientM m)
-> (forall e a.
    Exception e =>
    ClientM m a -> (e -> ClientM m a) -> ClientM m a)
-> MonadCatch (ClientM m)
ClientM m a -> (e -> ClientM m a) -> ClientM m a
forall e a.
Exception e =>
ClientM m a -> (e -> ClientM m a) -> ClientM m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (ClientM m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ClientM m a -> (e -> ClientM m a) -> ClientM m a
catch :: ClientM m a -> (e -> ClientM m a) -> ClientM m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ClientM m a -> (e -> ClientM m a) -> ClientM m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (ClientM m)
MonadCatch, MonadCatch (ClientM m)
MonadCatch (ClientM m)
-> (forall b.
    ((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
    -> ClientM m b)
-> (forall b.
    ((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
    -> ClientM m b)
-> (forall a b c.
    ClientM m a
    -> (a -> ExitCase b -> ClientM m c)
    -> (a -> ClientM m b)
    -> ClientM m (b, c))
-> MonadMask (ClientM m)
ClientM m a
-> (a -> ExitCase b -> ClientM m c)
-> (a -> ClientM m b)
-> ClientM m (b, c)
((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
forall b.
((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
forall a b c.
ClientM m a
-> (a -> ExitCase b -> ClientM m c)
-> (a -> ClientM m b)
-> ClientM m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (ClientM m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
forall (m :: * -> *) a b c.
MonadMask m =>
ClientM m a
-> (a -> ExitCase b -> ClientM m c)
-> (a -> ClientM m b)
-> ClientM m (b, c)
generalBracket :: ClientM m a
-> (a -> ExitCase b -> ClientM m c)
-> (a -> ClientM m b)
-> ClientM m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
ClientM m a
-> (a -> ExitCase b -> ClientM m c)
-> (a -> ClientM m b)
-> ClientM m (b, c)
uninterruptibleMask :: ((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
mask :: ((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. ClientM m a -> ClientM m a) -> ClientM m b)
-> ClientM m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (ClientM m)
MonadMask)

instance MonadTrans ClientM where
	lift :: m a -> ClientM m a
lift = ServerM (ReaderT CommandOptions m) a -> ClientM m a
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) a -> ClientM m a)
-> (m a -> ServerM (ReaderT CommandOptions m) a)
-> m a
-> ClientM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CommandOptions m a -> ServerM (ReaderT CommandOptions m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT CommandOptions m a
 -> ServerM (ReaderT CommandOptions m) a)
-> (m a -> ReaderT CommandOptions m a)
-> m a
-> ServerM (ReaderT CommandOptions m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT CommandOptions m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadIO m, MonadMask m) => MonadLog (ClientM m) where
	askLog :: ClientM m Log
askLog = ServerM (ReaderT CommandOptions m) Log -> ClientM m Log
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM ServerM (ReaderT CommandOptions m) Log
forall (m :: * -> *). MonadLog m => m Log
askLog
	localLog :: (Log -> Log) -> ClientM m a -> ClientM m a
localLog Log -> Log
fn = ServerM (ReaderT CommandOptions m) a -> ClientM m a
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) a -> ClientM m a)
-> (ClientM m a -> ServerM (ReaderT CommandOptions m) a)
-> ClientM m a
-> ClientM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Log -> Log)
-> ServerM (ReaderT CommandOptions m) a
-> ServerM (ReaderT CommandOptions m) a
forall (m :: * -> *) a. MonadLog m => (Log -> Log) -> m a -> m a
localLog Log -> Log
fn (ServerM (ReaderT CommandOptions m) a
 -> ServerM (ReaderT CommandOptions m) a)
-> (ClientM m a -> ServerM (ReaderT CommandOptions m) a)
-> ClientM m a
-> ServerM (ReaderT CommandOptions m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM m a -> ServerM (ReaderT CommandOptions m) a
forall (m :: * -> *) a.
ClientM m a -> ServerM (ReaderT CommandOptions m) a
runClientM

instance ServerMonadBase m => SessionMonad (ClientM m) where
	getSession :: ClientM m Session
getSession = ServerM (ReaderT CommandOptions m) Session -> ClientM m Session
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM ServerM (ReaderT CommandOptions m) Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
	localSession :: (Session -> Session) -> ClientM m a -> ClientM m a
localSession Session -> Session
fn = ServerM (ReaderT CommandOptions m) a -> ClientM m a
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) a -> ClientM m a)
-> (ClientM m a -> ServerM (ReaderT CommandOptions m) a)
-> ClientM m a
-> ClientM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> Session)
-> ServerM (ReaderT CommandOptions m) a
-> ServerM (ReaderT CommandOptions m) a
forall (m :: * -> *) a.
SessionMonad m =>
(Session -> Session) -> m a -> m a
localSession Session -> Session
fn (ServerM (ReaderT CommandOptions m) a
 -> ServerM (ReaderT CommandOptions m) a)
-> (ClientM m a -> ServerM (ReaderT CommandOptions m) a)
-> ClientM m a
-> ServerM (ReaderT CommandOptions m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM m a -> ServerM (ReaderT CommandOptions m) a
forall (m :: * -> *) a.
ClientM m a -> ServerM (ReaderT CommandOptions m) a
runClientM

instance ServerMonadBase m => CommandMonad (ClientM m) where
	getOptions :: ClientM m CommandOptions
getOptions = ServerM (ReaderT CommandOptions m) CommandOptions
-> ClientM m CommandOptions
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) CommandOptions
 -> ClientM m CommandOptions)
-> ServerM (ReaderT CommandOptions m) CommandOptions
-> ClientM m CommandOptions
forall a b. (a -> b) -> a -> b
$ ReaderT CommandOptions m CommandOptions
-> ServerM (ReaderT CommandOptions m) CommandOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT CommandOptions m CommandOptions
forall r (m :: * -> *). MonadReader r m => m r
ask

instance MonadBase b m => MonadBase b (ClientM m) where
	liftBase :: b α -> ClientM m α
liftBase = ServerM (ReaderT CommandOptions m) α -> ClientM m α
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) α -> ClientM m α)
-> (b α -> ServerM (ReaderT CommandOptions m) α)
-> b α
-> ClientM m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> ServerM (ReaderT CommandOptions m) α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadBaseControl b m => MonadBaseControl b (ClientM m) where
	type StM (ClientM m) a = StM (ServerM (ReaderT CommandOptions m)) a
	liftBaseWith :: (RunInBase (ClientM m) b -> b a) -> ClientM m a
liftBaseWith RunInBase (ClientM m) b -> b a
f = ServerM (ReaderT CommandOptions m) a -> ClientM m a
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) a -> ClientM m a)
-> ServerM (ReaderT CommandOptions m) a -> ClientM m a
forall a b. (a -> b) -> a -> b
$ (RunInBase (ServerM (ReaderT CommandOptions m)) b -> b a)
-> ServerM (ReaderT CommandOptions m) a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase (ServerM (ReaderT CommandOptions m)) b
f' -> RunInBase (ClientM m) b -> b a
f (ServerM (ReaderT CommandOptions m) a -> b (StM m a)
RunInBase (ServerM (ReaderT CommandOptions m)) b
f' (ServerM (ReaderT CommandOptions m) a -> b (StM m a))
-> (ClientM m a -> ServerM (ReaderT CommandOptions m) a)
-> ClientM m a
-> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM m a -> ServerM (ReaderT CommandOptions m) a
forall (m :: * -> *) a.
ClientM m a -> ServerM (ReaderT CommandOptions m) a
runClientM))
	restoreM :: StM (ClientM m) a -> ClientM m a
restoreM = ServerM (ReaderT CommandOptions m) a -> ClientM m a
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions m) a -> ClientM m a)
-> (StM m a -> ServerM (ReaderT CommandOptions m) a)
-> StM m a
-> ClientM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> ServerM (ReaderT CommandOptions m) a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

instance MFunctor ClientM where
	hoist :: (forall a. m a -> n a) -> ClientM m b -> ClientM n b
hoist forall a. m a -> n a
fn = ServerM (ReaderT CommandOptions n) b -> ClientM n b
forall (m :: * -> *) a.
ServerM (ReaderT CommandOptions m) a -> ClientM m a
ClientM (ServerM (ReaderT CommandOptions n) b -> ClientM n b)
-> (ClientM m b -> ServerM (ReaderT CommandOptions n) b)
-> ClientM m b
-> ClientM n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 ReaderT CommandOptions m a -> ReaderT CommandOptions n a)
-> ServerM (ReaderT CommandOptions m) b
-> ServerM (ReaderT CommandOptions n) b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a)
-> ReaderT CommandOptions m a -> ReaderT CommandOptions n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
fn) (ServerM (ReaderT CommandOptions m) b
 -> ServerM (ReaderT CommandOptions n) b)
-> (ClientM m b -> ServerM (ReaderT CommandOptions m) b)
-> ClientM m b
-> ServerM (ReaderT CommandOptions n) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM m b -> ServerM (ReaderT CommandOptions m) b
forall (m :: * -> *) a.
ClientM m a -> ServerM (ReaderT CommandOptions m) a
runClientM

instance CommandMonad m => CommandMonad (ReaderT r m) where
	getOptions :: ReaderT r m CommandOptions
getOptions = m CommandOptions -> ReaderT r m CommandOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CommandOptions
forall (m :: * -> *). CommandMonad m => m CommandOptions
getOptions

instance (CommandMonad m, Monoid w) => CommandMonad (WriterT w m) where
	getOptions :: WriterT w m CommandOptions
getOptions = m CommandOptions -> WriterT w m CommandOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CommandOptions
forall (m :: * -> *). CommandMonad m => m CommandOptions
getOptions

instance CommandMonad m => CommandMonad (StateT s m) where
	getOptions :: StateT s m CommandOptions
getOptions = m CommandOptions -> StateT s m CommandOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CommandOptions
forall (m :: * -> *). CommandMonad m => m CommandOptions
getOptions

-- | Run action on session
withSession :: Session -> ServerM m a -> m a
withSession :: Session -> ServerM m a -> m a
withSession Session
s ServerM m a
act = ReaderT Session m a -> Session -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ServerM m a -> ReaderT Session m a
forall (m :: * -> *) a. ServerM m a -> ReaderT Session m a
runServerM ServerM m a
act) Session
s

-- | Listen server's log
serverListen :: SessionMonad m => m [Log.Message]
serverListen :: m [Message]
serverListen = m (m [Message]) -> m [Message]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m [Message]) -> m [Message])
-> (m (IO [Message]) -> m (m [Message]))
-> m (IO [Message])
-> m [Message]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO [Message] -> m [Message])
-> m (IO [Message]) -> m (m [Message])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IO [Message] -> m [Message]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (m (IO [Message]) -> m [Message])
-> m (IO [Message]) -> m [Message]
forall a b. (a -> b) -> a -> b
$ (Session -> IO [Message]) -> m (IO [Message])
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession (SessionLog -> IO [Message]
sessionListenLog (SessionLog -> IO [Message])
-> (Session -> SessionLog) -> Session -> IO [Message]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> SessionLog
sessionLog)

-- | Set server's log config
serverSetLogLevel :: SessionMonad m => Level -> m Level
serverSetLogLevel :: Level -> m Level
serverSetLogLevel Level
lev = do
	Log
l <- (Session -> Log) -> m Log
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession (SessionLog -> Log
sessionLogger (SessionLog -> Log) -> (Session -> SessionLog) -> Session -> Log
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> SessionLog
sessionLog)
	LogConfig
cfg <- Log -> (LogConfig -> LogConfig) -> m LogConfig
forall (m :: * -> *).
MonadIO m =>
Log -> (LogConfig -> LogConfig) -> m LogConfig
updateLogConfig Log
l (ASetter LogConfig LogConfig (Maybe Level) (Maybe Level)
-> Maybe Level -> LogConfig -> LogConfig
forall s t a b. ASetter s t a b -> b -> s -> t
set (Component -> Lens' LogConfig (Maybe Level)
componentCfg Component
"") (Level -> Maybe Level
forall a. a -> Maybe a
Just Level
lev))
	Level -> m Level
forall (m :: * -> *) a. Monad m => a -> m a
return (Level -> m Level) -> Level -> m Level
forall a b. (a -> b) -> a -> b
$ Level -> Maybe Level -> Level
forall a. a -> Maybe a -> a
fromMaybe Level
forall a. Default a => a
def (Maybe Level -> Level) -> Maybe Level -> Level
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Level) LogConfig (Maybe Level)
-> LogConfig -> Maybe Level
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Component -> Lens' LogConfig (Maybe Level)
componentCfg Component
"") LogConfig
cfg

-- | Wait for server
serverWait :: SessionMonad m => m ()
serverWait :: m ()
serverWait = m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> (m (IO ()) -> m (m ())) -> m (IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()) -> m (IO ()) -> m (m ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (m (IO ()) -> m ()) -> m (IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (Session -> IO ()) -> m (IO ())
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> IO ()
sessionWait

-- | Wait while clients disconnects
serverWaitClients :: SessionMonad m => m ()
serverWaitClients :: m ()
serverWaitClients = do
	Chan (IO ())
clientChan <- (Session -> Chan (IO ())) -> m (Chan (IO ()))
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> Chan (IO ())
sessionClients
	IO [IO ()] -> m [IO ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Chan (IO ()) -> IO [IO ()]
forall a. Chan a -> IO [a]
F.stopChan Chan (IO ())
clientChan) m [IO ()] -> ([IO ()] -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> m ()) -> ([IO ()] -> [m ()]) -> [IO ()] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()) -> [IO ()] -> [m ()]
forall a b. (a -> b) -> [a] -> [b]
map IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Get sql connection
serverSqlDatabase :: SessionMonad m => m SQL.Connection
serverSqlDatabase :: m Connection
serverSqlDatabase = (Session -> Connection) -> m Connection
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> Connection
sessionSqlDatabase

-- | Open new sql connection
openSqlConnection :: SessionMonad m => m SQL.Connection
openSqlConnection :: m Connection
openSqlConnection = do
	String
p <- (Session -> String) -> m String
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> String
sessionSqlPath
	-- FIXME: There's `new` function in HsDev's SQLite module
	IO Connection -> m Connection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ do
		Connection
conn <- String -> IO Connection
SQL.open String
p
		Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"pragma case_sensitive_like = true;"
		Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"pragma synchronous = off;"
		Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"pragma journal_mode = memory;"
		Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

-- | Close sql connection
closeSqlConnection :: SessionMonad m => SQL.Connection -> m ()
closeSqlConnection :: Connection -> m ()
closeSqlConnection = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Connection -> IO ()) -> Connection -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
SQL.close

-- | Locally opens new connection, updating @Session@
withSqlConnection :: SessionMonad m => m a -> m a
withSqlConnection :: m a -> m a
withSqlConnection m a
act = m Connection -> (Connection -> m ()) -> (Connection -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m Connection
forall (m :: * -> *). SessionMonad m => m Connection
openSqlConnection Connection -> m ()
forall (m :: * -> *). SessionMonad m => Connection -> m ()
closeSqlConnection ((Connection -> m a) -> m a) -> (Connection -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
	(Session -> Session) -> m a -> m a
forall (m :: * -> *) a.
SessionMonad m =>
(Session -> Session) -> m a -> m a
localSession (\Session
sess -> Session
sess { sessionSqlDatabase :: Connection
sessionSqlDatabase = Connection
conn }) m a
act

-- | With sql transaction
withSqlTransaction :: SessionMonad m => ServerM IO a -> m a
withSqlTransaction :: ServerM IO a -> m a
withSqlTransaction ServerM IO a
fn = do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	Session
sess <- m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
	IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Connection -> IO a -> IO a
forall a. Connection -> IO a -> IO a
SQL.withTransaction Connection
conn (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Session -> ServerM IO a -> IO a
forall (m :: * -> *) a. Session -> ServerM m a -> m a
withSession Session
sess ServerM IO a
fn

-- | Set custom file contents
serverSetFileContents :: SessionMonad m => Path -> Maybe Text -> m ()
serverSetFileContents :: Path -> Maybe Path -> m ()
serverSetFileContents Path
fpath Maybe Path
mcts = do
	Path -> Maybe Path -> IO ()
setCts <- (Session -> Path -> Maybe Path -> IO ())
-> m (Path -> Maybe Path -> IO ())
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> Path -> Maybe Path -> IO ()
sessionFileContents
	IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Path -> Maybe Path -> IO ()
setCts Path
fpath Maybe Path
mcts

-- | In ghc session
inSessionGhc :: SessionMonad m => GhcM a -> m a
inSessionGhc :: GhcM a -> m a
inSessionGhc GhcM a
act = do
	GhcWorker
ghcw <- (Session -> GhcWorker) -> m GhcWorker
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> GhcWorker
sessionGhc
	(SomeException -> m a) -> GhcWorker -> GhcM a -> m a
forall (m :: * -> *) (n :: * -> *) a.
(MonadIO m, MonadCatch m, MonadIO n) =>
(SomeException -> n a) -> Worker m -> m a -> n a
inWorkerWith (HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a)
-> (SomeException -> HsDevError) -> SomeException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
GhcError (String -> HsDevError)
-> (SomeException -> String) -> SomeException -> HsDevError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) GhcWorker
ghcw GhcM a
act

-- | In updater
inSessionUpdater :: SessionMonad m => ServerM IO a -> m a
inSessionUpdater :: ServerM IO a -> m a
inSessionUpdater ServerM IO a
act = do
	Worker (ServerM IO)
uw <- (Session -> Worker (ServerM IO)) -> m (Worker (ServerM IO))
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> Worker (ServerM IO)
sessionUpdater
	(SomeException -> m a)
-> Worker (ServerM IO) -> ServerM IO a -> m a
forall (m :: * -> *) (n :: * -> *) a.
(MonadIO m, MonadCatch m, MonadIO n) =>
(SomeException -> n a) -> Worker m -> m a -> n a
inWorkerWith (HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a)
-> (SomeException -> HsDevError) -> SomeException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
OtherError (String -> HsDevError)
-> (SomeException -> String) -> SomeException -> HsDevError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) Worker (ServerM IO)
uw ServerM IO a
act

-- | Post to updater and return
postSessionUpdater :: SessionMonad m => ServerM IO a -> m (Async a)
postSessionUpdater :: ServerM IO a -> m (Async a)
postSessionUpdater ServerM IO a
act = do
	Worker (ServerM IO)
uw <- (Session -> Worker (ServerM IO)) -> m (Worker (ServerM IO))
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> Worker (ServerM IO)
sessionUpdater
	IO (Async a) -> m (Async a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async a) -> m (Async a)) -> IO (Async a) -> m (Async a)
forall a b. (a -> b) -> a -> b
$ Worker (ServerM IO) -> ServerM IO a -> IO (Async a)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Worker m -> m a -> IO (Async a)
sendTask Worker (ServerM IO)
uw ServerM IO a
act

-- | Exit session
serverExit :: SessionMonad m => m ()
serverExit :: m ()
serverExit = m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> (m (IO ()) -> m (m ())) -> m (IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()) -> m (IO ()) -> m (m ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (m (IO ()) -> m ()) -> m (IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (Session -> IO ()) -> m (IO ())
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> IO ()
sessionExit

commandRoot :: CommandMonad m => m FilePath
commandRoot :: m String
commandRoot = (CommandOptions -> String) -> m String
forall (m :: * -> *) a.
CommandMonad m =>
(CommandOptions -> a) -> m a
askOptions CommandOptions -> String
commandOptionsRoot

commandNotify :: CommandMonad m => Notification -> m ()
commandNotify :: Notification -> m ()
commandNotify Notification
n = m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> (m (IO ()) -> m (m ())) -> m (IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()) -> m (IO ()) -> m (m ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (m (IO ()) -> m ()) -> m (IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (CommandOptions -> Notification -> IO ())
-> m (Notification -> IO ())
forall (m :: * -> *) a.
CommandMonad m =>
(CommandOptions -> a) -> m a
askOptions CommandOptions -> Notification -> IO ()
commandOptionsNotify m (Notification -> IO ()) -> m Notification -> m (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Notification -> m Notification
forall (f :: * -> *) a. Applicative f => a -> f a
pure Notification
n

commandLink :: CommandMonad m => m ()
commandLink :: m ()
commandLink = m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> (m (IO ()) -> m (m ())) -> m (IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()) -> m (IO ()) -> m (m ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (m (IO ()) -> m ()) -> m (IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (CommandOptions -> IO ()) -> m (IO ())
forall (m :: * -> *) a.
CommandMonad m =>
(CommandOptions -> a) -> m a
askOptions CommandOptions -> IO ()
commandOptionsLink

commandHold :: CommandMonad m => m ()
commandHold :: m ()
commandHold = m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> (m (IO ()) -> m (m ())) -> m (IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()) -> m (IO ()) -> m (m ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (m (IO ()) -> m ()) -> m (IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (CommandOptions -> IO ()) -> m (IO ())
forall (m :: * -> *) a.
CommandMonad m =>
(CommandOptions -> a) -> m a
askOptions CommandOptions -> IO ()
commandOptionsHold

-- | Server control command
data ServerCommand =
	Version Bool |
	Start ServerOpts |
	Run ServerOpts |
	Stop ClientOpts |
	Connect ClientOpts |
	Remote ClientOpts Bool Command
		deriving (Int -> ServerCommand -> ShowS
[ServerCommand] -> ShowS
ServerCommand -> String
(Int -> ServerCommand -> ShowS)
-> (ServerCommand -> String)
-> ([ServerCommand] -> ShowS)
-> Show ServerCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerCommand] -> ShowS
$cshowList :: [ServerCommand] -> ShowS
show :: ServerCommand -> String
$cshow :: ServerCommand -> String
showsPrec :: Int -> ServerCommand -> ShowS
$cshowsPrec :: Int -> ServerCommand -> ShowS
Show)

data ConnectionPort = NetworkPort Int | UnixPort String deriving (ConnectionPort -> ConnectionPort -> Bool
(ConnectionPort -> ConnectionPort -> Bool)
-> (ConnectionPort -> ConnectionPort -> Bool) -> Eq ConnectionPort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionPort -> ConnectionPort -> Bool
$c/= :: ConnectionPort -> ConnectionPort -> Bool
== :: ConnectionPort -> ConnectionPort -> Bool
$c== :: ConnectionPort -> ConnectionPort -> Bool
Eq, ReadPrec [ConnectionPort]
ReadPrec ConnectionPort
Int -> ReadS ConnectionPort
ReadS [ConnectionPort]
(Int -> ReadS ConnectionPort)
-> ReadS [ConnectionPort]
-> ReadPrec ConnectionPort
-> ReadPrec [ConnectionPort]
-> Read ConnectionPort
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectionPort]
$creadListPrec :: ReadPrec [ConnectionPort]
readPrec :: ReadPrec ConnectionPort
$creadPrec :: ReadPrec ConnectionPort
readList :: ReadS [ConnectionPort]
$creadList :: ReadS [ConnectionPort]
readsPrec :: Int -> ReadS ConnectionPort
$creadsPrec :: Int -> ReadS ConnectionPort
Read)

instance Default ConnectionPort where
	def :: ConnectionPort
def = Int -> ConnectionPort
NetworkPort Int
4567

instance Show ConnectionPort where
	show :: ConnectionPort -> String
show (NetworkPort Int
p) = Int -> String
forall a. Show a => a -> String
show Int
p
	show (UnixPort String
s) = String
"unix " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

instance Formattable ConnectionPort

-- | Server options
data ServerOpts = ServerOpts {
	ServerOpts -> ConnectionPort
serverPort :: ConnectionPort,
	ServerOpts -> Int
serverTimeout :: Int,
	ServerOpts -> Maybe String
serverLog :: Maybe FilePath,
	ServerOpts -> String
serverLogLevel :: String,
	ServerOpts -> Bool
serverLogNoColor :: Bool,
	ServerOpts -> Maybe String
serverDbFile :: Maybe FilePath,
	ServerOpts -> Bool
serverWatchFS :: Bool,
	ServerOpts -> Bool
serverSilent :: Bool }
		deriving (Int -> ServerOpts -> ShowS
[ServerOpts] -> ShowS
ServerOpts -> String
(Int -> ServerOpts -> ShowS)
-> (ServerOpts -> String)
-> ([ServerOpts] -> ShowS)
-> Show ServerOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerOpts] -> ShowS
$cshowList :: [ServerOpts] -> ShowS
show :: ServerOpts -> String
$cshow :: ServerOpts -> String
showsPrec :: Int -> ServerOpts -> ShowS
$cshowsPrec :: Int -> ServerOpts -> ShowS
Show)

instance Default ServerOpts where
	def :: ServerOpts
def = ConnectionPort
-> Int
-> Maybe String
-> String
-> Bool
-> Maybe String
-> Bool
-> Bool
-> ServerOpts
ServerOpts ConnectionPort
forall a. Default a => a
def Int
0 Maybe String
forall a. Maybe a
Nothing String
"info" Bool
False Maybe String
forall a. Maybe a
Nothing Bool
True Bool
False

-- | Silent server with no connection, useful for ghci
silentOpts :: ServerOpts
silentOpts :: ServerOpts
silentOpts = ServerOpts
forall a. Default a => a
def { serverSilent :: Bool
serverSilent = Bool
True }

-- | Client options
data ClientOpts = ClientOpts {
	ClientOpts -> ConnectionPort
clientPort :: ConnectionPort,
	ClientOpts -> Bool
clientPretty :: Bool,
	ClientOpts -> Bool
clientStdin :: Bool,
	ClientOpts -> Int
clientTimeout :: Int,
	ClientOpts -> Bool
clientSilent :: Bool }
		deriving (Int -> ClientOpts -> ShowS
[ClientOpts] -> ShowS
ClientOpts -> String
(Int -> ClientOpts -> ShowS)
-> (ClientOpts -> String)
-> ([ClientOpts] -> ShowS)
-> Show ClientOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientOpts] -> ShowS
$cshowList :: [ClientOpts] -> ShowS
show :: ClientOpts -> String
$cshow :: ClientOpts -> String
showsPrec :: Int -> ClientOpts -> ShowS
$cshowsPrec :: Int -> ClientOpts -> ShowS
Show)

instance Default ClientOpts where
	def :: ClientOpts
def = ConnectionPort -> Bool -> Bool -> Int -> Bool -> ClientOpts
ClientOpts ConnectionPort
forall a. Default a => a
def Bool
False Bool
False Int
0 Bool
False

instance FromCmd ServerCommand where
	cmdP :: Parser ServerCommand
cmdP = Parser ServerCommand
serv Parser ServerCommand
-> Parser ServerCommand -> Parser ServerCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ServerCommand
remote where
		serv :: Parser ServerCommand
serv = Mod CommandFields ServerCommand -> Parser ServerCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields ServerCommand -> Parser ServerCommand)
-> Mod CommandFields ServerCommand -> Parser ServerCommand
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields ServerCommand]
-> Mod CommandFields ServerCommand
forall a. Monoid a => [a] -> a
mconcat [
			String
-> String
-> Parser ServerCommand
-> Mod CommandFields ServerCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"version" String
"hsdev version" (Bool -> ServerCommand
Version (Bool -> ServerCommand) -> Parser Bool -> Parser ServerCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
compilerVersionFlag),
			String
-> String
-> Parser ServerCommand
-> Mod CommandFields ServerCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"start" String
"start remote server" (ServerOpts -> ServerCommand
Start (ServerOpts -> ServerCommand)
-> Parser ServerOpts -> Parser ServerCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ServerOpts
forall a. FromCmd a => Parser a
cmdP),
			String
-> String
-> Parser ServerCommand
-> Mod CommandFields ServerCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"run" String
"run server" (ServerOpts -> ServerCommand
Run (ServerOpts -> ServerCommand)
-> Parser ServerOpts -> Parser ServerCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ServerOpts
forall a. FromCmd a => Parser a
cmdP),
			String
-> String
-> Parser ServerCommand
-> Mod CommandFields ServerCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"stop" String
"stop remote server" (ClientOpts -> ServerCommand
Stop (ClientOpts -> ServerCommand)
-> Parser ClientOpts -> Parser ServerCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClientOpts
forall a. FromCmd a => Parser a
cmdP),
			String
-> String
-> Parser ServerCommand
-> Mod CommandFields ServerCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"connect" String
"connect to send commands directly" (ClientOpts -> ServerCommand
Connect (ClientOpts -> ServerCommand)
-> Parser ClientOpts -> Parser ServerCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClientOpts
forall a. FromCmd a => Parser a
cmdP)]
		remote :: Parser ServerCommand
remote = ClientOpts -> Bool -> Command -> ServerCommand
Remote (ClientOpts -> Bool -> Command -> ServerCommand)
-> Parser ClientOpts -> Parser (Bool -> Command -> ServerCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClientOpts
forall a. FromCmd a => Parser a
cmdP Parser (Bool -> Command -> ServerCommand)
-> Parser Bool -> Parser (Command -> ServerCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
noFileFlag Parser (Command -> ServerCommand)
-> Parser Command -> Parser ServerCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
forall a. FromCmd a => Parser a
cmdP

instance FromCmd ServerOpts where
	cmdP :: Parser ServerOpts
cmdP = ConnectionPort
-> Int
-> Maybe String
-> String
-> Bool
-> Maybe String
-> Bool
-> Bool
-> ServerOpts
ServerOpts (ConnectionPort
 -> Int
 -> Maybe String
 -> String
 -> Bool
 -> Maybe String
 -> Bool
 -> Bool
 -> ServerOpts)
-> Parser ConnectionPort
-> Parser
     (Int
      -> Maybe String
      -> String
      -> Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> ServerOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		(Parser ConnectionPort
connectionArg Parser ConnectionPort
-> Parser ConnectionPort -> Parser ConnectionPort
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConnectionPort -> Parser ConnectionPort
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerOpts -> ConnectionPort
serverPort ServerOpts
forall a. Default a => a
def)) Parser
  (Int
   -> Maybe String
   -> String
   -> Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> ServerOpts)
-> Parser Int
-> Parser
     (Maybe String
      -> String -> Bool -> Maybe String -> Bool -> Bool -> ServerOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Parser Int
timeoutArg Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerOpts -> Int
serverTimeout ServerOpts
forall a. Default a => a
def)) Parser
  (Maybe String
   -> String -> Bool -> Maybe String -> Bool -> Bool -> ServerOpts)
-> Parser (Maybe String)
-> Parser
     (String -> Bool -> Maybe String -> Bool -> Bool -> ServerOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
logArg Parser
  (String -> Bool -> Maybe String -> Bool -> Bool -> ServerOpts)
-> Parser String
-> Parser (Bool -> Maybe String -> Bool -> Bool -> ServerOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Parser String
logLevelArg Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerOpts -> String
serverLogLevel ServerOpts
forall a. Default a => a
def)) Parser (Bool -> Maybe String -> Bool -> Bool -> ServerOpts)
-> Parser Bool
-> Parser (Maybe String -> Bool -> Bool -> ServerOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser Bool
noColorFlag Parser (Maybe String -> Bool -> Bool -> ServerOpts)
-> Parser (Maybe String) -> Parser (Bool -> Bool -> ServerOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
dbFileArg Parser (Bool -> Bool -> ServerOpts)
-> Parser Bool -> Parser (Bool -> ServerOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Bool -> Bool
not (Bool -> Bool) -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
noWatchFlag) Parser (Bool -> ServerOpts) -> Parser Bool -> Parser ServerOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser Bool
serverSilentFlag

instance FromCmd ClientOpts where
	cmdP :: Parser ClientOpts
cmdP = ConnectionPort -> Bool -> Bool -> Int -> Bool -> ClientOpts
ClientOpts (ConnectionPort -> Bool -> Bool -> Int -> Bool -> ClientOpts)
-> Parser ConnectionPort
-> Parser (Bool -> Bool -> Int -> Bool -> ClientOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		(Parser ConnectionPort
connectionArg Parser ConnectionPort
-> Parser ConnectionPort -> Parser ConnectionPort
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConnectionPort -> Parser ConnectionPort
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientOpts -> ConnectionPort
clientPort ClientOpts
forall a. Default a => a
def)) Parser (Bool -> Bool -> Int -> Bool -> ClientOpts)
-> Parser Bool -> Parser (Bool -> Int -> Bool -> ClientOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser Bool
prettyFlag Parser (Bool -> Int -> Bool -> ClientOpts)
-> Parser Bool -> Parser (Int -> Bool -> ClientOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser Bool
stdinFlag Parser (Int -> Bool -> ClientOpts)
-> Parser Int -> Parser (Bool -> ClientOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Parser Int
timeoutArg Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientOpts -> Int
clientTimeout ClientOpts
forall a. Default a => a
def)) Parser (Bool -> ClientOpts) -> Parser Bool -> Parser ClientOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Parser Bool
silentFlag

portArg :: Parser ConnectionPort
compilerVersionFlag :: Parser Bool
connectionArg :: Parser ConnectionPort
timeoutArg :: Parser Int
logArg :: Parser FilePath
logLevelArg :: Parser String
noColorFlag :: Parser Bool
noFileFlag :: Parser Bool
prettyFlag :: Parser Bool
serverSilentFlag :: Parser Bool
stdinFlag :: Parser Bool
silentFlag :: Parser Bool
dbFileArg :: Parser FilePath
noWatchFlag :: Parser Bool

portArg :: Parser ConnectionPort
portArg = Int -> ConnectionPort
NetworkPort (Int -> ConnectionPort) -> Parser Int -> Parser ConnectionPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"number" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"connection port")
compilerVersionFlag :: Parser Bool
compilerVersionFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"compiler" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"show compiler version")
#if mingw32_HOST_OS
connectionArg = portArg
#else
unixArg :: Parser ConnectionPort
unixArg :: Parser ConnectionPort
unixArg = String -> ConnectionPort
UnixPort (String -> ConnectionPort)
-> Parser String -> Parser ConnectionPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"unix" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"name" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"unix connection port")
connectionArg :: Parser ConnectionPort
connectionArg = Parser ConnectionPort
portArg Parser ConnectionPort
-> Parser ConnectionPort -> Parser ConnectionPort
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConnectionPort
unixArg
#endif
timeoutArg :: Parser Int
timeoutArg = ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"timeout" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"msec" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"query timeout")
logArg :: Parser String
logArg = Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"file" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"log file")
logLevelArg :: Parser String
logLevelArg = Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"level" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"log level: trace/debug/info/warning/error/fatal")
noColorFlag :: Parser Bool
noColorFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-color" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't use colorized log output")
noFileFlag :: Parser Bool
noFileFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-file" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't use mmap files")
prettyFlag :: Parser Bool
prettyFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pretty" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"pretty json output")
serverSilentFlag :: Parser Bool
serverSilentFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"silent" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"no stdout/stderr")
stdinFlag :: Parser Bool
stdinFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stdin" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"pass data to stdin")
silentFlag :: Parser Bool
silentFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"silent" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"supress notifications")
dbFileArg :: Parser String
dbFileArg = Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"db" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"path to sql database")
noWatchFlag :: Parser Bool
noWatchFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-watch" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't watch filesystem for source changes")

serverOptsArgs :: ServerOpts -> [String]
serverOptsArgs :: ServerOpts -> FormatFlags
serverOptsArgs ServerOpts
sopts = [FormatFlags] -> FormatFlags
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
	ConnectionPort -> FormatFlags
portArgs (ServerOpts -> ConnectionPort
serverPort ServerOpts
sopts),
	[String
"--timeout", Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ ServerOpts -> Int
serverTimeout ServerOpts
sopts],
	String -> Maybe String -> FormatFlags
marg String
"--log" (ServerOpts -> Maybe String
serverLog ServerOpts
sopts),
	[String
"--log-level", ServerOpts -> String
serverLogLevel ServerOpts
sopts],
	String -> Maybe String -> FormatFlags
marg String
"--db" (ServerOpts -> Maybe String
serverDbFile ServerOpts
sopts),
	[String
"--silent" | ServerOpts -> Bool
serverSilent ServerOpts
sopts]]
	where
		marg :: String -> Maybe String -> [String]
		marg :: String -> Maybe String -> FormatFlags
marg String
n (Just String
v) = [String
n, String
v]
		marg String
_ Maybe String
_ = []
		portArgs :: ConnectionPort -> [String]
		portArgs :: ConnectionPort -> FormatFlags
portArgs (NetworkPort Int
n) = [String
"--port", Int -> String
forall a. Show a => a -> String
show Int
n]
		portArgs (UnixPort String
s) = [String
"--unix", String
s]

data Request = Request {
	Request -> Command
requestCommand :: Command,
	Request -> String
requestDirectory :: FilePath,
	Request -> Bool
requestNoFile :: Bool,
	Request -> Int
requestTimeout :: Int,
	Request -> Bool
requestSilent :: Bool }
		deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

instance ToJSON Request where
	toJSON :: Request -> Value
toJSON (Request Command
c String
dir Bool
f Int
tm Bool
s) = [Pair] -> Value
object [Path
"current-directory" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
dir, Path
"no-file" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
f, Path
"timeout" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
tm, Path
"silent" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
s] Value -> Value -> Value
`objectUnion` Command -> Value
forall a. ToJSON a => a -> Value
toJSON Command
c

instance FromJSON Request where
	parseJSON :: Value -> Parser Request
parseJSON = String -> (Object -> Parser Request) -> Value -> Parser Request
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"request" ((Object -> Parser Request) -> Value -> Parser Request)
-> (Object -> Parser Request) -> Value -> Parser Request
forall a b. (a -> b) -> a -> b
$ \Object
v -> Command -> String -> Bool -> Int -> Bool -> Request
Request (Command -> String -> Bool -> Int -> Bool -> Request)
-> Parser Command
-> Parser (String -> Bool -> Int -> Bool -> Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Value -> Parser Command
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v) Parser (String -> Bool -> Int -> Bool -> Request)
-> Parser String -> Parser (Bool -> Int -> Bool -> Request)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		((Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"current-directory") Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
".") Parser (Bool -> Int -> Bool -> Request)
-> Parser Bool -> Parser (Int -> Bool -> Request)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		((Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"no-file") Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser (Int -> Bool -> Request)
-> Parser Int -> Parser (Bool -> Request)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		((Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"timeout") Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) Parser (Bool -> Request) -> Parser Bool -> Parser Request
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		((Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"silent") Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

-- | Command from client
data Command =
	Ping |
	Listen (Maybe String) |
	SetLogLevel String |
	Scan {
		Command -> [Path]
scanProjects :: [Path],
		Command -> Bool
scanCabal :: Bool,
		Command -> [Path]
scanSandboxes :: [Path],
		Command -> [FileSource]
scanFiles :: [FileSource],
		Command -> [Path]
scanPaths :: [Path],
		Command -> BuildTool
scanBuildTool :: BuildTool,
		Command -> FormatFlags
scanGhcOpts :: [String],
		Command -> Bool
scanDocs :: Bool,
		Command -> Bool
scanInferTypes :: Bool } |
	ScanProject {
		Command -> Path
scanProjectPath :: Path,
		Command -> BuildTool
scanProjectBuildTool :: BuildTool,
		Command -> Bool
scanProjectDeps :: Bool } |
	ScanFile {
		Command -> Path
scanFilePath :: Path,
		Command -> BuildTool
scanFileBuildTool :: BuildTool,
		Command -> Bool
scanFileProject :: Bool,
		Command -> Bool
scanFileDeps :: Bool } |
	ScanPackageDbs {
		Command -> PackageDbStack
scanPackageDbStack :: PackageDbStack } |
	SetFileContents Path (Maybe Text) |
	RefineDocs {
		Command -> [Path]
docsProjects :: [Path],
		Command -> [Path]
docsFiles :: [Path] } |
	InferTypes {
		Command -> [Path]
inferProjects :: [Path],
		Command -> [Path]
inferFiles :: [Path] } |
	Remove {
		Command -> [Path]
removeProjects :: [Path],
		Command -> Bool
removeCabal :: Bool,
		Command -> [Path]
removeSandboxes :: [Path],
		Command -> [Path]
removeFiles :: [Path] } |
	RemoveAll |
	InfoPackages |
	InfoProjects |
	InfoSandboxes |
	InfoSymbol SearchQuery [TargetFilter] Bool Bool |
	InfoModule SearchQuery [TargetFilter] Bool Bool |
	InfoProject (Either Text Path) |
	InfoSandbox Path |
	Lookup Text Path |
	Whois Text Path |
	Whoat Int Int Path |
	ResolveScopeModules SearchQuery Path |
	ResolveScope SearchQuery Path |
	FindUsages Int Int Path |
	Complete Text Bool Path |
	Hayoo {
		Command -> String
hayooQuery :: String,
		Command -> Int
hayooPage :: Int,
		Command -> Int
hayooPages :: Int } |
	CabalList { Command -> [Path]
cabalListPackages :: [Text] } |
	UnresolvedSymbols {
		Command -> [Path]
unresolvedFiles :: [Path] } |
	Lint {
		Command -> [FileSource]
lintFiles :: [FileSource],
		Command -> FormatFlags
lintHlintOpts :: [String]
	} |
	Check {
		Command -> [FileSource]
checkFiles :: [FileSource],
		Command -> FormatFlags
checkGhcOpts :: [String],
		Command -> Bool
checkClear :: Bool } |
	CheckLint {
		Command -> [FileSource]
checkLintFiles :: [FileSource],
		Command -> FormatFlags
checkLintGhcOpts :: [String],
		Command -> FormatFlags
checkLintOpts :: [String],
		Command -> Bool
checkLinkClear :: Bool } |
	Types {
		Command -> [FileSource]
typesFiles :: [FileSource],
		Command -> FormatFlags
typesGhcOpts :: [String],
		Command -> Bool
typesClear :: Bool } |
	AutoFix [Note OutputMessage] |
	Refactor [Note Refact] [Note Refact] Bool |
	Rename {
		Command -> Path
renameSymbol :: Text,
		Command -> Path
renameTo :: Text,
		Command -> Maybe (Int, Int)
renameLocal :: Maybe (Int, Int),
		Command -> Path
renameContextFile :: Path } |
	GhcEval { Command -> FormatFlags
ghcEvalExpressions :: [String], Command -> Maybe FileSource
ghcEvalSource :: Maybe FileSource } |
	GhcType { Command -> FormatFlags
ghcTypeExpressions :: [String], Command -> Maybe FileSource
ghcTypeSource :: Maybe FileSource } |
	Langs |
	Flags |
	Link { Command -> Bool
linkHold :: Bool } |
	StopGhc |
	Exit
		deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

data FileSource = FileSource { FileSource -> Path
fileSource :: Path, FileSource -> Maybe Path
fileContents :: Maybe Text } deriving (Int -> FileSource -> ShowS
[FileSource] -> ShowS
FileSource -> String
(Int -> FileSource -> ShowS)
-> (FileSource -> String)
-> ([FileSource] -> ShowS)
-> Show FileSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSource] -> ShowS
$cshowList :: [FileSource] -> ShowS
show :: FileSource -> String
$cshow :: FileSource -> String
showsPrec :: Int -> FileSource -> ShowS
$cshowsPrec :: Int -> FileSource -> ShowS
Show)
data TargetFilter =
	TargetProject Text |
	TargetFile Path |
	TargetModule Text |
	TargetPackage Text |
	TargetInstalled |
	TargetSourced |
	TargetStandalone
		deriving (TargetFilter -> TargetFilter -> Bool
(TargetFilter -> TargetFilter -> Bool)
-> (TargetFilter -> TargetFilter -> Bool) -> Eq TargetFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetFilter -> TargetFilter -> Bool
$c/= :: TargetFilter -> TargetFilter -> Bool
== :: TargetFilter -> TargetFilter -> Bool
$c== :: TargetFilter -> TargetFilter -> Bool
Eq, Int -> TargetFilter -> ShowS
[TargetFilter] -> ShowS
TargetFilter -> String
(Int -> TargetFilter -> ShowS)
-> (TargetFilter -> String)
-> ([TargetFilter] -> ShowS)
-> Show TargetFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetFilter] -> ShowS
$cshowList :: [TargetFilter] -> ShowS
show :: TargetFilter -> String
$cshow :: TargetFilter -> String
showsPrec :: Int -> TargetFilter -> ShowS
$cshowsPrec :: Int -> TargetFilter -> ShowS
Show)
data SearchQuery = SearchQuery Text SearchType deriving (Int -> SearchQuery -> ShowS
[SearchQuery] -> ShowS
SearchQuery -> String
(Int -> SearchQuery -> ShowS)
-> (SearchQuery -> String)
-> ([SearchQuery] -> ShowS)
-> Show SearchQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchQuery] -> ShowS
$cshowList :: [SearchQuery] -> ShowS
show :: SearchQuery -> String
$cshow :: SearchQuery -> String
showsPrec :: Int -> SearchQuery -> ShowS
$cshowsPrec :: Int -> SearchQuery -> ShowS
Show)
data SearchType = SearchExact | SearchPrefix | SearchInfix | SearchSuffix deriving (Int -> SearchType -> ShowS
[SearchType] -> ShowS
SearchType -> String
(Int -> SearchType -> ShowS)
-> (SearchType -> String)
-> ([SearchType] -> ShowS)
-> Show SearchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchType] -> ShowS
$cshowList :: [SearchType] -> ShowS
show :: SearchType -> String
$cshow :: SearchType -> String
showsPrec :: Int -> SearchType -> ShowS
$cshowsPrec :: Int -> SearchType -> ShowS
Show)

instance Paths Command where
	paths :: (String -> f String) -> Command -> f Command
paths String -> f String
f (Scan [Path]
projs Bool
c [Path]
cs [FileSource]
fs [Path]
ps BuildTool
btool FormatFlags
ghcs Bool
docs Bool
infer) = [Path]
-> Bool
-> [Path]
-> [FileSource]
-> [Path]
-> BuildTool
-> FormatFlags
-> Bool
-> Bool
-> Command
Scan ([Path]
 -> Bool
 -> [Path]
 -> [FileSource]
 -> [Path]
 -> BuildTool
 -> FormatFlags
 -> Bool
 -> Bool
 -> Command)
-> f [Path]
-> f (Bool
      -> [Path]
      -> [FileSource]
      -> [Path]
      -> BuildTool
      -> FormatFlags
      -> Bool
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		(Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
projs f (Bool
   -> [Path]
   -> [FileSource]
   -> [Path]
   -> BuildTool
   -> FormatFlags
   -> Bool
   -> Bool
   -> Command)
-> f Bool
-> f ([Path]
      -> [FileSource]
      -> [Path]
      -> BuildTool
      -> FormatFlags
      -> Bool
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c f ([Path]
   -> [FileSource]
   -> [Path]
   -> BuildTool
   -> FormatFlags
   -> Bool
   -> Bool
   -> Command)
-> f [Path]
-> f ([FileSource]
      -> [Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
cs f ([FileSource]
   -> [Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> f [FileSource]
-> f ([Path]
      -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(FileSource -> f FileSource) -> [FileSource] -> f [FileSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) [FileSource]
fs f ([Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> f [Path]
-> f (BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
ps f (BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> f BuildTool -> f (FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		BuildTool -> f BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
btool f (FormatFlags -> Bool -> Bool -> Command)
-> f FormatFlags -> f (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		FormatFlags -> f FormatFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormatFlags
ghcs f (Bool -> Bool -> Command) -> f Bool -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
docs f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
infer
	paths String -> f String
f (ScanProject Path
proj BuildTool
tool Bool
deps) = Path -> BuildTool -> Bool -> Command
ScanProject (Path -> BuildTool -> Bool -> Command)
-> f Path -> f (BuildTool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
proj f (BuildTool -> Bool -> Command)
-> f BuildTool -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuildTool -> f BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
tool f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
deps
	paths String -> f String
f (ScanFile Path
file' BuildTool
tool Bool
scanProj Bool
deps) = Path -> BuildTool -> Bool -> Bool -> Command
ScanFile (Path -> BuildTool -> Bool -> Bool -> Command)
-> f Path -> f (BuildTool -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
file' f (BuildTool -> Bool -> Bool -> Command)
-> f BuildTool -> f (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuildTool -> f BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
tool f (Bool -> Bool -> Command) -> f Bool -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
scanProj f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
deps
	paths String -> f String
f (ScanPackageDbs PackageDbStack
pdbs) = PackageDbStack -> Command
ScanPackageDbs (PackageDbStack -> Command) -> f PackageDbStack -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> PackageDbStack -> f PackageDbStack
forall a. Paths a => Traversal' a String
paths String -> f String
f PackageDbStack
pdbs
	paths String -> f String
f (SetFileContents Path
p Maybe Path
cts) = Path -> Maybe Path -> Command
SetFileContents (Path -> Maybe Path -> Command)
-> f Path -> f (Maybe Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
p f (Maybe Path -> Command) -> f (Maybe Path) -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Path -> f (Maybe Path)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Path
cts
	paths String -> f String
f (RefineDocs [Path]
projs [Path]
fs) = [Path] -> [Path] -> Command
RefineDocs ([Path] -> [Path] -> Command) -> f [Path] -> f ([Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
projs f ([Path] -> Command) -> f [Path] -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
fs
	paths String -> f String
f (InferTypes [Path]
projs [Path]
fs) = [Path] -> [Path] -> Command
InferTypes ([Path] -> [Path] -> Command) -> f [Path] -> f ([Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
projs f ([Path] -> Command) -> f [Path] -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
fs
	paths String -> f String
f (Remove [Path]
projs Bool
c [Path]
cs [Path]
fs) = [Path] -> Bool -> [Path] -> [Path] -> Command
Remove ([Path] -> Bool -> [Path] -> [Path] -> Command)
-> f [Path] -> f (Bool -> [Path] -> [Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
projs f (Bool -> [Path] -> [Path] -> Command)
-> f Bool -> f ([Path] -> [Path] -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c f ([Path] -> [Path] -> Command)
-> f [Path] -> f ([Path] -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
cs f ([Path] -> Command) -> f [Path] -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
fs
	paths String -> f String
_ Command
RemoveAll = Command -> f Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
RemoveAll
	paths String -> f String
f (InfoSymbol SearchQuery
q [TargetFilter]
t Bool
h Bool
l) = SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command
InfoSymbol (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command)
-> f SearchQuery -> f ([TargetFilter] -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SearchQuery -> f SearchQuery
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchQuery
q f ([TargetFilter] -> Bool -> Bool -> Command)
-> f [TargetFilter] -> f (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TargetFilter -> f TargetFilter)
-> [TargetFilter] -> f [TargetFilter]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> TargetFilter -> f TargetFilter
forall a. Paths a => Traversal' a String
paths String -> f String
f) [TargetFilter]
t f (Bool -> Bool -> Command) -> f Bool -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
h f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
l
	paths String -> f String
f (InfoModule SearchQuery
q [TargetFilter]
t Bool
h Bool
i) = SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command
InfoModule (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command)
-> f SearchQuery -> f ([TargetFilter] -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SearchQuery -> f SearchQuery
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchQuery
q f ([TargetFilter] -> Bool -> Bool -> Command)
-> f [TargetFilter] -> f (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TargetFilter -> f TargetFilter)
-> [TargetFilter] -> f [TargetFilter]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> TargetFilter -> f TargetFilter
forall a. Paths a => Traversal' a String
paths String -> f String
f) [TargetFilter]
t f (Bool -> Bool -> Command) -> f Bool -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
h f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
i
	paths String -> f String
f (InfoProject (Right Path
proj)) = Either Path Path -> Command
InfoProject (Either Path Path -> Command) -> f (Either Path Path) -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path -> Either Path Path
forall a b. b -> Either a b
Right (Path -> Either Path Path) -> f Path -> f (Either Path Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
proj)
	paths String -> f String
f (InfoSandbox Path
fpath) = Path -> Command
InfoSandbox (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (Lookup Path
n Path
fpath) = Path -> Path -> Command
Lookup (Path -> Path -> Command) -> f Path -> f (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> f Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
n f (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (Whois Path
n Path
fpath) = Path -> Path -> Command
Whois (Path -> Path -> Command) -> f Path -> f (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> f Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
n f (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (Whoat Int
l Int
c Path
fpath) = Int -> Int -> Path -> Command
Whoat (Int -> Int -> Path -> Command)
-> f Int -> f (Int -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
l f (Int -> Path -> Command) -> f Int -> f (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
c f (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (ResolveScopeModules SearchQuery
q Path
fpath) = SearchQuery -> Path -> Command
ResolveScopeModules SearchQuery
q (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (ResolveScope SearchQuery
q Path
fpath) = SearchQuery -> Path -> Command
ResolveScope SearchQuery
q (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (FindUsages Int
l Int
c Path
fpath) = Int -> Int -> Path -> Command
FindUsages (Int -> Int -> Path -> Command)
-> f Int -> f (Int -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
l f (Int -> Path -> Command) -> f Int -> f (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
c f (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (Complete Path
n Bool
g Path
fpath) = Path -> Bool -> Path -> Command
Complete Path
n Bool
g (Path -> Command) -> f Path -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
f (UnresolvedSymbols [Path]
fs) = [Path] -> Command
UnresolvedSymbols ([Path] -> Command) -> f [Path] -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path -> f Path) -> [Path] -> f [Path]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Path]
fs
	paths String -> f String
f (Lint [FileSource]
fs FormatFlags
lints) = [FileSource] -> FormatFlags -> Command
Lint ([FileSource] -> FormatFlags -> Command)
-> f [FileSource] -> f (FormatFlags -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileSource -> f FileSource) -> [FileSource] -> f [FileSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) [FileSource]
fs f (FormatFlags -> Command) -> f FormatFlags -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormatFlags -> f FormatFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormatFlags
lints
	paths String -> f String
f (Check [FileSource]
fs FormatFlags
ghcs Bool
c) = [FileSource] -> FormatFlags -> Bool -> Command
Check ([FileSource] -> FormatFlags -> Bool -> Command)
-> f [FileSource] -> f (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileSource -> f FileSource) -> [FileSource] -> f [FileSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) [FileSource]
fs f (FormatFlags -> Bool -> Command)
-> f FormatFlags -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormatFlags -> f FormatFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormatFlags
ghcs f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c
	paths String -> f String
f (CheckLint [FileSource]
fs FormatFlags
ghcs FormatFlags
lints Bool
c) = [FileSource] -> FormatFlags -> FormatFlags -> Bool -> Command
CheckLint ([FileSource] -> FormatFlags -> FormatFlags -> Bool -> Command)
-> f [FileSource]
-> f (FormatFlags -> FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileSource -> f FileSource) -> [FileSource] -> f [FileSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) [FileSource]
fs f (FormatFlags -> FormatFlags -> Bool -> Command)
-> f FormatFlags -> f (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormatFlags -> f FormatFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormatFlags
ghcs f (FormatFlags -> Bool -> Command)
-> f FormatFlags -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormatFlags -> f FormatFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormatFlags
lints f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c
	paths String -> f String
f (Types [FileSource]
fs FormatFlags
ghcs Bool
c) = [FileSource] -> FormatFlags -> Bool -> Command
Types ([FileSource] -> FormatFlags -> Bool -> Command)
-> f [FileSource] -> f (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileSource -> f FileSource) -> [FileSource] -> f [FileSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) [FileSource]
fs f (FormatFlags -> Bool -> Command)
-> f FormatFlags -> f (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormatFlags -> f FormatFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormatFlags
ghcs f (Bool -> Command) -> f Bool -> f Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c
	paths String -> f String
f (GhcEval FormatFlags
e Maybe FileSource
mf) = FormatFlags -> Maybe FileSource -> Command
GhcEval FormatFlags
e (Maybe FileSource -> Command) -> f (Maybe FileSource) -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileSource -> f FileSource)
-> Maybe FileSource -> f (Maybe FileSource)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) Maybe FileSource
mf
	paths String -> f String
f (GhcType FormatFlags
e Maybe FileSource
mf) = FormatFlags -> Maybe FileSource -> Command
GhcType FormatFlags
e (Maybe FileSource -> Command) -> f (Maybe FileSource) -> f Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileSource -> f FileSource)
-> Maybe FileSource -> f (Maybe FileSource)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> FileSource -> f FileSource
forall a. Paths a => Traversal' a String
paths String -> f String
f) Maybe FileSource
mf
	paths String -> f String
_ Command
c = Command -> f Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
c

instance Paths FileSource where
	paths :: (String -> f String) -> FileSource -> f FileSource
paths String -> f String
f (FileSource Path
fpath Maybe Path
mcts) = Path -> Maybe Path -> FileSource
FileSource (Path -> Maybe Path -> FileSource)
-> f Path -> f (Maybe Path -> FileSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath f (Maybe Path -> FileSource) -> f (Maybe Path) -> f FileSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Path -> f (Maybe Path)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Path
mcts

instance Paths TargetFilter where
	paths :: (String -> f String) -> TargetFilter -> f TargetFilter
paths String -> f String
f (TargetFile Path
fpath) = Path -> TargetFilter
TargetFile (Path -> TargetFilter) -> f Path -> f TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Path -> f Path
forall a. Paths a => Traversal' a String
paths String -> f String
f Path
fpath
	paths String -> f String
_ TargetFilter
t = TargetFilter -> f TargetFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure TargetFilter
t

instance FromCmd Command where
	cmdP :: Parser Command
cmdP = Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat [
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"ping" String
"ping server" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Ping),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"listen" String
"listen server log" (Maybe String -> Command
Listen (Maybe String -> Command)
-> Parser (Maybe String) -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
logLevelArg),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"set-log" String
"set log level" (String -> Command
SetLogLevel (String -> Command) -> Parser String -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument Mod ArgumentFields String
forall m. Monoid m => m
idm),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"scan" String
"scan sources" (
			Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"project" String
"scan project" (Path -> BuildTool -> Bool -> Command
ScanProject (Path -> BuildTool -> Bool -> Command)
-> Parser Path -> Parser (BuildTool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (BuildTool -> Bool -> Command)
-> Parser BuildTool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser BuildTool
toolArg Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
depsArg)) Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
			Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"file" String
"scan file" (Path -> BuildTool -> Bool -> Bool -> Command
ScanFile (Path -> BuildTool -> Bool -> Bool -> Command)
-> Parser Path -> Parser (BuildTool -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (BuildTool -> Bool -> Bool -> Command)
-> Parser BuildTool -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser BuildTool
toolArg Parser BuildTool -> Parser BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
CabalTool) Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
depProjArg Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
depsArg)) Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
			Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"package-dbs" String
"scan package-dbs; note, that order of package-dbs matters - dependent package-dbs should go first" (PackageDbStack -> Command
ScanPackageDbs (PackageDbStack -> Command)
-> Parser PackageDbStack -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([PackageDb] -> PackageDbStack
mkPackageDbStack ([PackageDb] -> PackageDbStack)
-> Parser [PackageDb] -> Parser PackageDbStack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PackageDb -> Parser [PackageDb]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser PackageDb
packageDbArg))) Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
			([Path]
-> Bool
-> [Path]
-> [FileSource]
-> [Path]
-> BuildTool
-> FormatFlags
-> Bool
-> Bool
-> Command
Scan ([Path]
 -> Bool
 -> [Path]
 -> [FileSource]
 -> [Path]
 -> BuildTool
 -> FormatFlags
 -> Bool
 -> Bool
 -> Command)
-> Parser [Path]
-> Parser
     (Bool
      -> [Path]
      -> [FileSource]
      -> [Path]
      -> BuildTool
      -> FormatFlags
      -> Bool
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
				Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
projectArg Parser
  (Bool
   -> [Path]
   -> [FileSource]
   -> [Path]
   -> BuildTool
   -> FormatFlags
   -> Bool
   -> Bool
   -> Command)
-> Parser Bool
-> Parser
     ([Path]
      -> [FileSource]
      -> [Path]
      -> BuildTool
      -> FormatFlags
      -> Bool
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser Bool
cabalFlag Parser
  ([Path]
   -> [FileSource]
   -> [Path]
   -> BuildTool
   -> FormatFlags
   -> Bool
   -> Bool
   -> Command)
-> Parser [Path]
-> Parser
     ([FileSource]
      -> [Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
sandboxArg Parser
  ([FileSource]
   -> [Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> Parser [FileSource]
-> Parser
     ([Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser FileSource -> Parser [FileSource]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FileSource
forall a. FromCmd a => Parser a
cmdP Parser
  ([Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> Parser [Path]
-> Parser (BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser Path
pathArg (Mod OptionFields String -> Parser Path)
-> Mod OptionFields String -> Parser Path
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"path") Parser (BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> Parser BuildTool
-> Parser (FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				(Parser BuildTool
toolArg' Parser BuildTool -> Parser BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
CabalTool) Parser (FormatFlags -> Bool -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser FormatFlags
ghcOpts Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser Bool
docsFlag Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
				Parser Bool
inferFlag)),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"set-file-contents" String
"set edited file contents, which will be used instead of contents in file until it updated" (Parser Command -> Mod CommandFields Command)
-> Parser Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$
			Path -> Maybe Path -> Command
SetFileContents (Path -> Maybe Path -> Command)
-> Parser Path -> Parser (Maybe Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
fileArg Parser (Maybe Path -> Command)
-> Parser (Maybe Path) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path -> Parser (Maybe Path)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Path
contentsArg,
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"docs" String
"scan docs" (Parser Command -> Mod CommandFields Command)
-> Parser Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ [Path] -> [Path] -> Command
RefineDocs ([Path] -> [Path] -> Command)
-> Parser [Path] -> Parser ([Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
projectArg Parser ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
fileArg,
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"infer" String
"infer types" (Parser Command -> Mod CommandFields Command)
-> Parser Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ [Path] -> [Path] -> Command
InferTypes ([Path] -> [Path] -> Command)
-> Parser [Path] -> Parser ([Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
projectArg Parser ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
fileArg,
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"remove" String
"remove modules info" (Parser Command -> Mod CommandFields Command)
-> Parser Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ [Path] -> Bool -> [Path] -> [Path] -> Command
Remove ([Path] -> Bool -> [Path] -> [Path] -> Command)
-> Parser [Path] -> Parser (Bool -> [Path] -> [Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
projectArg Parser (Bool -> [Path] -> [Path] -> Command)
-> Parser Bool -> Parser ([Path] -> [Path] -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Parser Bool
cabalFlag Parser ([Path] -> [Path] -> Command)
-> Parser [Path] -> Parser ([Path] -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
sandboxArg Parser ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
fileArg,
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"remove-all" String
"remove all data" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
RemoveAll),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"packages" String
"list packages" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
InfoPackages),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"projects" String
"list projects" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
InfoProjects),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"sandboxes" String
"list sandboxes" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
InfoSandboxes),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"symbol" String
"get symbol info" (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command
InfoSymbol (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command)
-> Parser SearchQuery
-> Parser ([TargetFilter] -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SearchQuery
forall a. FromCmd a => Parser a
cmdP Parser ([TargetFilter] -> Bool -> Bool -> Command)
-> Parser [TargetFilter] -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TargetFilter -> Parser [TargetFilter]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TargetFilter
forall a. FromCmd a => Parser a
cmdP Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
headerFlag Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
localsFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"module" String
"get module info" (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command
InfoModule (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command)
-> Parser SearchQuery
-> Parser ([TargetFilter] -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SearchQuery
forall a. FromCmd a => Parser a
cmdP Parser ([TargetFilter] -> Bool -> Bool -> Command)
-> Parser [TargetFilter] -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TargetFilter -> Parser [TargetFilter]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TargetFilter
forall a. FromCmd a => Parser a
cmdP Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
headerFlag Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
inspectionFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"project" String
"get project info" (Either Path Path -> Command
InfoProject (Either Path Path -> Command)
-> Parser (Either Path Path) -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Path -> Either Path Path
forall a b. a -> Either a b
Left (Path -> Either Path Path)
-> Parser Path -> Parser (Either Path Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
projectArg) Parser (Either Path Path)
-> Parser (Either Path Path) -> Parser (Either Path Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Path -> Either Path Path
forall a b. b -> Either a b
Right (Path -> Either Path Path)
-> Parser Path -> Parser (Either Path Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser Path
pathArg Mod OptionFields String
forall m. Monoid m => m
idm))),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"sandbox" String
"get sandbox info" (Path -> Command
InfoSandbox (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser Path
pathArg (String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"locate sandbox in parent of this path")),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"lookup" String
"lookup for symbol" (Path -> Path -> Command
Lookup (Path -> Path -> Command)
-> Parser Path -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"whois" String
"get info for symbol" (Path -> Path -> Command
Whois (Path -> Path -> Command)
-> Parser Path -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"whoat" String
"get info for symbol under cursor" (Int -> Int -> Path -> Command
Whoat (Int -> Int -> Path -> Command)
-> Parser Int -> Parser (Int -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"line") Parser (Int -> Path -> Command)
-> Parser Int -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"column") Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"scope" String
"get declarations accessible from module or within a project" (
			Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"modules" String
"get modules accessible from module or within a project" (SearchQuery -> Path -> Command
ResolveScopeModules (SearchQuery -> Path -> Command)
-> Parser SearchQuery -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SearchQuery
forall a. FromCmd a => Parser a
cmdP Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx)) Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
			SearchQuery -> Path -> Command
ResolveScope (SearchQuery -> Path -> Command)
-> Parser SearchQuery -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SearchQuery
forall a. FromCmd a => Parser a
cmdP Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"usages" String
"find usages of symbol within project/module" (Int -> Int -> Path -> Command
FindUsages (Int -> Int -> Path -> Command)
-> Parser Int -> Parser (Int -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"line") Parser (Int -> Path -> Command)
-> Parser Int -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"column") Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"complete" String
"show completions for input" (Path -> Bool -> Path -> Command
Complete (Path -> Bool -> Path -> Command)
-> Parser Path -> Parser (Bool -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (Bool -> Path -> Command)
-> Parser Bool -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
wideFlag Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"hayoo" String
"find declarations online via Hayoo" (String -> Int -> Int -> Command
Hayoo (String -> Int -> Int -> Command)
-> Parser String -> Parser (Int -> Int -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (Int -> Int -> Command)
-> Parser Int -> Parser (Int -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
hayooPageArg Parser (Int -> Command) -> Parser Int -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
hayooPagesArg),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"cabal" String
"cabal commands" (Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"list" String
"list cabal packages" ([Path] -> Command
CabalList ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm))),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"unresolveds" String
"list unresolved symbols in source file" ([Path] -> Command
UnresolvedSymbols ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path -> Parser [Path]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Path
fileArg),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"lint" String
"lint source files or file contents" ([FileSource] -> FormatFlags -> Command
Lint ([FileSource] -> FormatFlags -> Command)
-> Parser [FileSource] -> Parser (FormatFlags -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FileSource -> Parser [FileSource]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FileSource
forall a. FromCmd a => Parser a
cmdP Parser (FormatFlags -> Command)
-> Parser FormatFlags -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FormatFlags
lintOpts),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"check" String
"check source files or file contents" ([FileSource] -> FormatFlags -> Bool -> Command
Check ([FileSource] -> FormatFlags -> Bool -> Command)
-> Parser [FileSource] -> Parser (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FileSource -> Parser [FileSource]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FileSource
forall a. FromCmd a => Parser a
cmdP Parser (FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FormatFlags
ghcOpts Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
clearFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"check-lint" String
"check and lint source files or file contents" ([FileSource] -> FormatFlags -> FormatFlags -> Bool -> Command
CheckLint ([FileSource] -> FormatFlags -> FormatFlags -> Bool -> Command)
-> Parser [FileSource]
-> Parser (FormatFlags -> FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FileSource -> Parser [FileSource]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FileSource
forall a. FromCmd a => Parser a
cmdP Parser (FormatFlags -> FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FormatFlags
ghcOpts Parser (FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FormatFlags
lintOpts Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
clearFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"types" String
"get types for file expressions" ([FileSource] -> FormatFlags -> Bool -> Command
Types ([FileSource] -> FormatFlags -> Bool -> Command)
-> Parser [FileSource] -> Parser (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FileSource -> Parser [FileSource]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FileSource
forall a. FromCmd a => Parser a
cmdP Parser (FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FormatFlags
ghcOpts Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
clearFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"autofixes" String
"get autofixes by output messages" ([Note OutputMessage] -> Command
AutoFix ([Note OutputMessage] -> Command)
-> Parser [Note OutputMessage] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM [Note OutputMessage]
-> Mod OptionFields [Note OutputMessage]
-> Parser [Note OutputMessage]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM [Note OutputMessage]
forall a. FromJSON a => ReadM a
readJSON (String -> Mod OptionFields [Note OutputMessage]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"data" Mod OptionFields [Note OutputMessage]
-> Mod OptionFields [Note OutputMessage]
-> Mod OptionFields [Note OutputMessage]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [Note OutputMessage]
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"message" Mod OptionFields [Note OutputMessage]
-> Mod OptionFields [Note OutputMessage]
-> Mod OptionFields [Note OutputMessage]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [Note OutputMessage]
forall (f :: * -> *) a. String -> Mod f a
help String
"messages to make fixes for")),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"refactor" String
"apply some refactors and get rest updated" ([Note Refact] -> [Note Refact] -> Bool -> Command
Refactor ([Note Refact] -> [Note Refact] -> Bool -> Command)
-> Parser [Note Refact]
-> Parser ([Note Refact] -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			ReadM [Note Refact]
-> Mod OptionFields [Note Refact] -> Parser [Note Refact]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM [Note Refact]
forall a. FromJSON a => ReadM a
readJSON (String -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"data" Mod OptionFields [Note Refact]
-> Mod OptionFields [Note Refact] -> Mod OptionFields [Note Refact]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"message" Mod OptionFields [Note Refact]
-> Mod OptionFields [Note Refact] -> Mod OptionFields [Note Refact]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. String -> Mod f a
help String
"messages to fix") Parser ([Note Refact] -> Bool -> Command)
-> Parser [Note Refact] -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			ReadM [Note Refact]
-> Mod OptionFields [Note Refact] -> Parser [Note Refact]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM [Note Refact]
forall a. FromJSON a => ReadM a
readJSON (String -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"rest" Mod OptionFields [Note Refact]
-> Mod OptionFields [Note Refact] -> Mod OptionFields [Note Refact]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"correction" Mod OptionFields [Note Refact]
-> Mod OptionFields [Note Refact] -> Mod OptionFields [Note Refact]
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod OptionFields [Note Refact]
-> Mod OptionFields [Note Refact] -> Mod OptionFields [Note Refact]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [Note Refact]
forall (f :: * -> *) a. String -> Mod f a
help String
"update corrections") Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Parser Bool
pureFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"rename" String
"get rename refactors" (Path -> Path -> Maybe (Int, Int) -> Path -> Command
Rename (Path -> Path -> Maybe (Int, Int) -> Path -> Command)
-> Parser Path
-> Parser (Path -> Maybe (Int, Int) -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (Path -> Maybe (Int, Int) -> Path -> Command)
-> Parser Path -> Parser (Maybe (Int, Int) -> Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser (Maybe (Int, Int) -> Path -> Command)
-> Parser (Maybe (Int, Int)) -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int -> Int -> (Int, Int))
-> Maybe Int -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Maybe Int -> Maybe Int -> Maybe (Int, Int))
-> Parser (Maybe Int) -> Parser (Maybe Int -> Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
lineArg Parser (Maybe Int -> Maybe (Int, Int))
-> Parser (Maybe Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
columnArg) Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ctx),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"ghc" String
"ghc commands" (
				Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"eval" String
"evaluate expression" (FormatFlags -> Maybe FileSource -> Command
GhcEval (FormatFlags -> Maybe FileSource -> Command)
-> Parser FormatFlags -> Parser (Maybe FileSource -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser FormatFlags
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument Mod ArgumentFields String
forall m. Monoid m => m
idm) Parser (Maybe FileSource -> Command)
-> Parser (Maybe FileSource) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FileSource -> Parser (Maybe FileSource)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FileSource
forall a. FromCmd a => Parser a
cmdP)) Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
				Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"type" String
"expression type" (FormatFlags -> Maybe FileSource -> Command
GhcType (FormatFlags -> Maybe FileSource -> Command)
-> Parser FormatFlags -> Parser (Maybe FileSource -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser FormatFlags
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument Mod ArgumentFields String
forall m. Monoid m => m
idm) Parser (Maybe FileSource -> Command)
-> Parser (Maybe FileSource) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FileSource -> Parser (Maybe FileSource)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FileSource
forall a. FromCmd a => Parser a
cmdP))),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"langs" String
"ghc language options" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Langs),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"flags" String
"ghc flags" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Flags),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"link" String
"link to server" (Bool -> Command
Link (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
holdFlag),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"stop-ghc" String
"stop ghc sessions" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
StopGhc),
		String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
cmd String
"exit" String
"exit" (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Exit)]

instance FromCmd FileSource where
	cmdP :: Parser FileSource
cmdP = ReadM FileSource
-> Mod OptionFields FileSource -> Parser FileSource
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FileSource
forall a. FromJSON a => ReadM a
readJSON (String -> Mod OptionFields FileSource
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"contents") Parser FileSource -> Parser FileSource -> Parser FileSource
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Path -> Maybe Path -> FileSource
FileSource (Path -> Maybe Path -> FileSource)
-> Parser Path -> Parser (Maybe Path -> FileSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
fileArg Parser (Maybe Path -> FileSource)
-> Parser (Maybe Path) -> Parser FileSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Path -> Parser (Maybe Path)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Path
forall a. Maybe a
Nothing)

instance FromCmd TargetFilter where
	cmdP :: Parser TargetFilter
cmdP = [Parser TargetFilter] -> Parser TargetFilter
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
		Path -> TargetFilter
TargetProject (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
projectArg,
		Path -> TargetFilter
TargetFile (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
fileArg,
		Path -> TargetFilter
TargetModule (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
moduleArg,
		Path -> TargetFilter
TargetPackage (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
packageArg,
		TargetFilter -> Mod FlagFields TargetFilter -> Parser TargetFilter
forall a. a -> Mod FlagFields a -> Parser a
flag' TargetFilter
TargetInstalled (String -> Mod FlagFields TargetFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"installed"),
		TargetFilter -> Mod FlagFields TargetFilter -> Parser TargetFilter
forall a. a -> Mod FlagFields a -> Parser a
flag' TargetFilter
TargetSourced (String -> Mod FlagFields TargetFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"src"),
		TargetFilter -> Mod FlagFields TargetFilter -> Parser TargetFilter
forall a. a -> Mod FlagFields a -> Parser a
flag' TargetFilter
TargetStandalone (String -> Mod FlagFields TargetFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stand")]

instance FromCmd SearchQuery where
	cmdP :: Parser SearchQuery
cmdP = Path -> SearchType -> SearchQuery
SearchQuery (Path -> SearchType -> SearchQuery)
-> Parser Path -> Parser (SearchType -> SearchQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mod ArgumentFields String -> Parser Path
textArgument Mod ArgumentFields String
forall m. Monoid m => m
idm Parser Path -> Parser Path -> Parser Path
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Path -> Parser Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
"") Parser (SearchType -> SearchQuery)
-> Parser SearchType -> Parser SearchQuery
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Parser SearchType] -> Parser SearchType
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
		SearchType -> Mod FlagFields SearchType -> Parser SearchType
forall a. a -> Mod FlagFields a -> Parser a
flag' SearchType
SearchExact (String -> Mod FlagFields SearchType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"exact"),
		SearchType -> Mod FlagFields SearchType -> Parser SearchType
forall a. a -> Mod FlagFields a -> Parser a
flag' SearchType
SearchInfix (String -> Mod FlagFields SearchType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"infix"),
		SearchType -> Mod FlagFields SearchType -> Parser SearchType
forall a. a -> Mod FlagFields a -> Parser a
flag' SearchType
SearchSuffix (String -> Mod FlagFields SearchType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"suffix"),
		SearchType -> Parser SearchType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchType
SearchPrefix Parser SearchType -> Parser Bool -> Parser SearchType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"prefix")]

readJSON :: FromJSON a => ReadM a
readJSON :: ReadM a
readJSON = ReadM String
forall s. IsString s => ReadM s
str ReadM String -> (String -> ReadM a) -> ReadM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReadM a -> (a -> ReadM a) -> Maybe a -> ReadM a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadM a
forall a. String -> ReadM a
readerError String
"Can't parse JSON argument") a -> ReadM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ReadM a) -> (String -> Maybe a) -> String -> ReadM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe a)
-> (String -> ByteString) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
L.pack

textOption :: Mod OptionFields String -> Parser Text
textOption :: Mod OptionFields String -> Parser Path
textOption = (String -> Path) -> Parser String -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Path
forall a. IsString a => String -> a
fromString (Parser String -> Parser Path)
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption

textArgument :: Mod ArgumentFields String -> Parser Text
textArgument :: Mod ArgumentFields String -> Parser Path
textArgument = (String -> Path) -> Parser String -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Path
forall a. IsString a => String -> a
fromString (Parser String -> Parser Path)
-> (Mod ArgumentFields String -> Parser String)
-> Mod ArgumentFields String
-> Parser Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument

cabalFlag :: Parser Bool
clearFlag :: Parser Bool
columnArg :: Parser Int
contentsArg :: Parser Text
ctx :: Parser Path
depProjArg :: Parser Bool
depsArg :: Parser Bool
docsFlag :: Parser Bool
fileArg :: Parser Path
ghcOpts :: Parser [String]
hayooPageArg :: Parser Int
hayooPagesArg :: Parser Int
headerFlag :: Parser Bool
holdFlag :: Parser Bool
inferFlag :: Parser Bool
inspectionFlag :: Parser Bool
lineArg :: Parser Int
lintOpts :: Parser [String]
localsFlag :: Parser Bool
moduleArg :: Parser Text
packageArg :: Parser Text
packageDbArg :: Parser PackageDb
pathArg :: Mod OptionFields String -> Parser Path
projectArg :: Parser Path
pureFlag :: Parser Bool
sandboxArg :: Parser Path
toolArg :: Parser BuildTool
toolArg' :: Parser BuildTool
wideFlag :: Parser Bool

cabalFlag :: Parser Bool
cabalFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cabal")
clearFlag :: Parser Bool
clearFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"clear" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"clear run, drop previous state")
columnArg :: Parser Int
columnArg = ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"column" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"column of symbol definition, required only for local symbols")
contentsArg :: Parser Path
contentsArg = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"contents" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"text contents")
ctx :: Parser Path
ctx = Parser Path
fileArg
depProjArg :: Parser Bool
depProjArg = (Bool -> Bool) -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-project" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't scan related project")
depsArg :: Parser Bool
depsArg = (Bool -> Bool) -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-deps" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't scan dependent package-dbs")
docsFlag :: Parser Bool
docsFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"docs" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"scan source file docs")
fileArg :: Parser Path
fileArg = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"file" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f')
ghcOpts :: Parser FormatFlags
ghcOpts = Parser String -> Parser FormatFlags
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghc" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"option" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"options to pass to GHC"))
hayooPageArg :: Parser Int
hayooPageArg = ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"page" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"n" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"page number (0 by default)" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
0)
hayooPagesArg :: Parser Int
hayooPagesArg = ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pages" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"count" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"pages count (1 by default)" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1)
headerFlag :: Parser Bool
headerFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"header" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"show only header of module")
holdFlag :: Parser Bool
holdFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hold" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't return any response")
inferFlag :: Parser Bool
inferFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"infer" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"infer types")
inspectionFlag :: Parser Bool
inspectionFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"inspection" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"return inspection data")
lineArg :: Parser Int
lineArg = ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"line" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"line of symbol definition, required only for local symbols")
lintOpts :: Parser FormatFlags
lintOpts = Parser String -> Parser FormatFlags
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"lint" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"option" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"options for hlint"))
localsFlag :: Parser Bool
localsFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"locals" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"look in local declarations")
moduleArg :: Parser Path
moduleArg = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"module" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"name" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"module name")
packageArg :: Parser Path
packageArg = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"package" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"name" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"module package")
packageDbArg :: Parser PackageDb
packageDbArg =
	PackageDb -> Mod FlagFields PackageDb -> Parser PackageDb
forall a. a -> Mod FlagFields a -> Parser a
flag' PackageDb
GlobalDb (String -> Mod FlagFields PackageDb
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"global-db" Mod FlagFields PackageDb
-> Mod FlagFields PackageDb -> Mod FlagFields PackageDb
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields PackageDb
forall (f :: * -> *) a. String -> Mod f a
help String
"global package-db") Parser PackageDb -> Parser PackageDb -> Parser PackageDb
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	PackageDb -> Mod FlagFields PackageDb -> Parser PackageDb
forall a. a -> Mod FlagFields a -> Parser a
flag' PackageDb
UserDb (String -> Mod FlagFields PackageDb
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"user-db" Mod FlagFields PackageDb
-> Mod FlagFields PackageDb -> Mod FlagFields PackageDb
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields PackageDb
forall (f :: * -> *) a. String -> Mod f a
help String
"per-user package-db") Parser PackageDb -> Parser PackageDb -> Parser PackageDb
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	(Path -> PackageDb) -> Parser Path -> Parser PackageDb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path -> PackageDb
PackageDb (Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"package-db" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"custom package-db"))
pathArg :: Mod OptionFields String -> Parser Path
pathArg Mod OptionFields String
f = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
f)
projectArg :: Parser Path
projectArg = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"project" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"proj" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"project")
pureFlag :: Parser Bool
pureFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pure" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't modify actual file, just return result")
sandboxArg :: Parser Path
sandboxArg = Mod OptionFields String -> Parser Path
textOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sandbox" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"path to cabal sandbox")
toolArg :: Parser BuildTool
toolArg =
	BuildTool -> Mod FlagFields BuildTool -> Parser BuildTool
forall a. a -> Mod FlagFields a -> Parser a
flag' BuildTool
CabalTool (String -> Mod FlagFields BuildTool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cabal" Mod FlagFields BuildTool
-> Mod FlagFields BuildTool -> Mod FlagFields BuildTool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BuildTool
forall (f :: * -> *) a. String -> Mod f a
help String
"use cabal as build tool") Parser BuildTool -> Parser BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	BuildTool -> Mod FlagFields BuildTool -> Parser BuildTool
forall a. a -> Mod FlagFields a -> Parser a
flag' BuildTool
StackTool (String -> Mod FlagFields BuildTool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stack" Mod FlagFields BuildTool
-> Mod FlagFields BuildTool -> Mod FlagFields BuildTool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BuildTool
forall (f :: * -> *) a. String -> Mod f a
help String
"use stack as build tool") Parser BuildTool -> Parser BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	Parser BuildTool
toolArg'
toolArg' :: Parser BuildTool
toolArg' = ReadM BuildTool -> Mod OptionFields BuildTool -> Parser BuildTool
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM BuildTool
readTool (String -> Mod OptionFields BuildTool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tool" Mod OptionFields BuildTool
-> Mod OptionFields BuildTool -> Mod OptionFields BuildTool
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields BuildTool
forall (f :: * -> *) a. String -> Mod f a
help String
"specify build tool, `cabal` or `stack`") where
	readTool :: ReadM BuildTool
	readTool :: ReadM BuildTool
readTool = do
		String
s <- IsString String => ReadM String
forall s. IsString s => ReadM s
str @String
		[ReadM BuildTool] -> ReadM BuildTool
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [
			Bool -> ReadM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cabal") ReadM () -> ReadM BuildTool -> ReadM BuildTool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BuildTool -> ReadM BuildTool
forall (m :: * -> *) a. Monad m => a -> m a
return BuildTool
CabalTool,
			Bool -> ReadM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stack") ReadM () -> ReadM BuildTool -> ReadM BuildTool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BuildTool -> ReadM BuildTool
forall (m :: * -> *) a. Monad m => a -> m a
return BuildTool
StackTool,
			String -> ReadM BuildTool
forall a. String -> ReadM a
readerError (Format
"unknown build tool: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
s)]

wideFlag :: Parser Bool
wideFlag = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"wide" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"wide mode - complete as if there were no import lists")

instance ToJSON Command where
	toJSON :: Command -> Value
toJSON Command
Ping = String -> [Pair] -> Value
cmdJson String
"ping" []
	toJSON (Listen Maybe String
lev) = String -> [Pair] -> Value
cmdJson String
"listen" [Path
"level" Path -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Maybe String
lev]
	toJSON (SetLogLevel String
lev) = String -> [Pair] -> Value
cmdJson String
"set-log" [Path
"level" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
lev]
	toJSON (Scan [Path]
projs Bool
cabal [Path]
sboxes [FileSource]
fs [Path]
ps BuildTool
btool FormatFlags
ghcs Bool
docs' Bool
infer') = String -> [Pair] -> Value
cmdJson String
"scan" [
		Path
"projects" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
projs,
		Path
"cabal" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
cabal,
		Path
"sandboxes" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
sboxes,
		Path
"files" Path -> [FileSource] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [FileSource]
fs,
		Path
"paths" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
ps,
		Path
"build-tool" Path -> BuildTool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= BuildTool
btool,
		Path
"ghc-opts" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
ghcs,
		Path
"docs" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
docs',
		Path
"infer" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
infer']
	toJSON (ScanProject Path
proj BuildTool
tool Bool
deps) = String -> [Pair] -> Value
cmdJson String
"scan project" [
		Path
"project" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
proj,
		Path
"build-tool" Path -> BuildTool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= BuildTool
tool,
		Path
"scan-deps" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
deps]
	toJSON (ScanFile Path
file' BuildTool
tool Bool
scanProj Bool
deps) = String -> [Pair] -> Value
cmdJson String
"scan file" [
		Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
file',
		Path
"build-tool" Path -> BuildTool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= BuildTool
tool,
		Path
"scan-project" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
scanProj,
		Path
"scan-deps" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
deps]
	toJSON (ScanPackageDbs PackageDbStack
pdbs) = String -> [Pair] -> Value
cmdJson String
"scan package-dbs" [
		Path
"package-db-stack" Path -> PackageDbStack -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= PackageDbStack
pdbs]
	toJSON (SetFileContents Path
f Maybe Path
cts) = String -> [Pair] -> Value
cmdJson String
"set-file-contents" [Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f, Path
"contents" Path -> Maybe Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Maybe Path
cts]
	toJSON (RefineDocs [Path]
projs [Path]
fs) = String -> [Pair] -> Value
cmdJson String
"docs" [Path
"projects" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
projs, Path
"files" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
fs]
	toJSON (InferTypes [Path]
projs [Path]
fs) = String -> [Pair] -> Value
cmdJson String
"infer" [Path
"projects" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
projs, Path
"files" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
fs]
	toJSON (Remove [Path]
projs Bool
cabal [Path]
sboxes [Path]
fs) = String -> [Pair] -> Value
cmdJson String
"remove" [Path
"projects" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
projs, Path
"cabal" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
cabal, Path
"sandboxes" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
sboxes, Path
"files" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
fs]
	toJSON Command
RemoveAll = String -> [Pair] -> Value
cmdJson String
"remove-all" []
	toJSON Command
InfoPackages = String -> [Pair] -> Value
cmdJson String
"packages" []
	toJSON Command
InfoProjects = String -> [Pair] -> Value
cmdJson String
"projects" []
	toJSON Command
InfoSandboxes = String -> [Pair] -> Value
cmdJson String
"sandboxes" []
	toJSON (InfoSymbol SearchQuery
q [TargetFilter]
tf Bool
h Bool
l) = String -> [Pair] -> Value
cmdJson String
"symbol" [Path
"query" Path -> SearchQuery -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= SearchQuery
q, Path
"filters" Path -> [TargetFilter] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [TargetFilter]
tf, Path
"header" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
h, Path
"locals" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
l]
	toJSON (InfoModule SearchQuery
q [TargetFilter]
tf Bool
h Bool
i) = String -> [Pair] -> Value
cmdJson String
"module" [Path
"query" Path -> SearchQuery -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= SearchQuery
q, Path
"filters" Path -> [TargetFilter] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [TargetFilter]
tf, Path
"header" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
h, Path
"inspection" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
i]
	toJSON (InfoProject Either Path Path
p) = String -> [Pair] -> Value
cmdJson String
"project" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Path -> [Pair]) -> (Path -> [Pair]) -> Either Path Path -> [Pair]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Path
pname -> [Path
"name" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
pname]) (\Path
ppath -> [Path
"path" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
ppath]) Either Path Path
p
	toJSON (InfoSandbox Path
p) = String -> [Pair] -> Value
cmdJson String
"sandbox" [Path
"path" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
p]
	toJSON (Lookup Path
n Path
f) = String -> [Pair] -> Value
cmdJson String
"lookup" [Path
"name" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
n, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (Whois Path
n Path
f) = String -> [Pair] -> Value
cmdJson String
"whois" [Path
"name" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
n, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (Whoat Int
l Int
c Path
f) = String -> [Pair] -> Value
cmdJson String
"whoat" [Path
"line" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
l, Path
"column" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
c, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (ResolveScopeModules SearchQuery
q Path
f) = String -> [Pair] -> Value
cmdJson String
"scope modules" [Path
"query" Path -> SearchQuery -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= SearchQuery
q, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (ResolveScope SearchQuery
q Path
f) = String -> [Pair] -> Value
cmdJson String
"scope" [Path
"query" Path -> SearchQuery -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= SearchQuery
q, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (FindUsages Int
l Int
c Path
f) = String -> [Pair] -> Value
cmdJson String
"usages" [Path
"line" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
l, Path
"column" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
c, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (Complete Path
q Bool
w Path
f) = String -> [Pair] -> Value
cmdJson String
"complete" [Path
"prefix" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
q, Path
"wide" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
w, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (Hayoo String
q Int
p Int
ps) = String -> [Pair] -> Value
cmdJson String
"hayoo" [Path
"query" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
q, Path
"page" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
p, Path
"pages" Path -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Int
ps]
	toJSON (CabalList [Path]
ps) = String -> [Pair] -> Value
cmdJson String
"cabal list" [Path
"packages" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
ps]
	toJSON (UnresolvedSymbols [Path]
fs) = String -> [Pair] -> Value
cmdJson String
"unresolveds" [Path
"files" Path -> [Path] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Path]
fs]
	toJSON (Lint [FileSource]
fs FormatFlags
lints) = String -> [Pair] -> Value
cmdJson String
"lint" [Path
"files" Path -> [FileSource] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [FileSource]
fs, Path
"lint-opts" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
lints]
	toJSON (Check [FileSource]
fs FormatFlags
ghcs Bool
c) = String -> [Pair] -> Value
cmdJson String
"check" [Path
"files" Path -> [FileSource] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [FileSource]
fs, Path
"ghc-opts" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
ghcs, Path
"clear" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
c]
	toJSON (CheckLint [FileSource]
fs FormatFlags
ghcs FormatFlags
lints Bool
c) = String -> [Pair] -> Value
cmdJson String
"check-lint" [Path
"files" Path -> [FileSource] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [FileSource]
fs, Path
"ghc-opts" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
ghcs, Path
"lint-opts" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
lints, Path
"clear" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
c]
	toJSON (Types [FileSource]
fs FormatFlags
ghcs Bool
c) = String -> [Pair] -> Value
cmdJson String
"types" [Path
"files" Path -> [FileSource] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [FileSource]
fs, Path
"ghc-opts" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
ghcs, Path
"clear" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
c]
	toJSON (AutoFix [Note OutputMessage]
ns) = String -> [Pair] -> Value
cmdJson String
"autofixes" [Path
"messages" Path -> [Note OutputMessage] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Note OutputMessage]
ns]
	toJSON (Refactor [Note Refact]
ns [Note Refact]
rests Bool
pure') = String -> [Pair] -> Value
cmdJson String
"refactor" [Path
"messages" Path -> [Note Refact] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Note Refact]
ns, Path
"rest" Path -> [Note Refact] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= [Note Refact]
rests, Path
"pure" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
pure']
	toJSON (Rename Path
n Path
n' Maybe (Int, Int)
mloc Path
f) = String -> [Pair] -> Value
cmdJson String
"rename" [Path
"name" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
n, Path
"new-name" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
n', Path
"line" Path -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> a
fst Maybe (Int, Int)
mloc, Path
"column" Path -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> b
snd Maybe (Int, Int)
mloc, Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (GhcEval FormatFlags
exprs Maybe FileSource
f) = String -> [Pair] -> Value
cmdJson String
"ghc eval" [Path
"exprs" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
exprs, Path
"file" Path -> Maybe FileSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Maybe FileSource
f]
	toJSON (GhcType FormatFlags
exprs Maybe FileSource
f) = String -> [Pair] -> Value
cmdJson String
"ghc type" [Path
"exprs" Path -> FormatFlags -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= FormatFlags
exprs, Path
"file" Path -> Maybe FileSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Maybe FileSource
f]
	toJSON Command
Langs = String -> [Pair] -> Value
cmdJson String
"langs" []
	toJSON Command
Flags = String -> [Pair] -> Value
cmdJson String
"flags" []
	toJSON (Link Bool
h) = String -> [Pair] -> Value
cmdJson String
"link" [Path
"hold" Path -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Bool
h]
	toJSON Command
StopGhc = String -> [Pair] -> Value
cmdJson String
"stop-ghc" []
	toJSON Command
Exit = String -> [Pair] -> Value
cmdJson String
"exit" []

instance FromJSON Command where
	parseJSON :: Value -> Parser Command
parseJSON = String -> (Object -> Parser Command) -> Value -> Parser Command
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"command" ((Object -> Parser Command) -> Value -> Parser Command)
-> (Object -> Parser Command) -> Value -> Parser Command
forall a b. (a -> b) -> a -> b
$ \Object
v -> [Parser Command] -> Parser Command
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
		String -> Object -> Parser ()
guardCmd String
"ping" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Ping,
		String -> Object -> Parser ()
guardCmd String
"listen" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe String -> Command
Listen (Maybe String -> Command)
-> Parser (Maybe String) -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser (Maybe String)
forall a. FromJSON a => Object -> Path -> Parser (Maybe a)
.::? Path
"level"),
		String -> Object -> Parser ()
guardCmd String
"set-log" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Command
SetLogLevel (String -> Command) -> Parser String -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"level"),
		String -> Object -> Parser ()
guardCmd String
"scan" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Path]
-> Bool
-> [Path]
-> [FileSource]
-> [Path]
-> BuildTool
-> FormatFlags
-> Bool
-> Bool
-> Command
Scan ([Path]
 -> Bool
 -> [Path]
 -> [FileSource]
 -> [Path]
 -> BuildTool
 -> FormatFlags
 -> Bool
 -> Bool
 -> Command)
-> Parser [Path]
-> Parser
     (Bool
      -> [Path]
      -> [FileSource]
      -> [Path]
      -> BuildTool
      -> FormatFlags
      -> Bool
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"projects" Parser
  (Bool
   -> [Path]
   -> [FileSource]
   -> [Path]
   -> BuildTool
   -> FormatFlags
   -> Bool
   -> Bool
   -> Command)
-> Parser Bool
-> Parser
     ([Path]
      -> [FileSource]
      -> [Path]
      -> BuildTool
      -> FormatFlags
      -> Bool
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"cabal" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser
  ([Path]
   -> [FileSource]
   -> [Path]
   -> BuildTool
   -> FormatFlags
   -> Bool
   -> Bool
   -> Command)
-> Parser [Path]
-> Parser
     ([FileSource]
      -> [Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"sandboxes" Parser
  ([FileSource]
   -> [Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> Parser [FileSource]
-> Parser
     ([Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser [FileSource]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files" Parser
  ([Path] -> BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> Parser [Path]
-> Parser (BuildTool -> FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"paths" Parser (BuildTool -> FormatFlags -> Bool -> Bool -> Command)
-> Parser BuildTool
-> Parser (FormatFlags -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser BuildTool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"build-tool" Parser BuildTool -> Parser BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
CabalTool) Parser (FormatFlags -> Bool -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"ghc-opts" Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"docs" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"infer" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
		String -> Object -> Parser ()
guardCmd String
"scan project" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> BuildTool -> Bool -> Command
ScanProject (Path -> BuildTool -> Bool -> Command)
-> Parser Path -> Parser (BuildTool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"project" Parser (BuildTool -> Bool -> Command)
-> Parser BuildTool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser BuildTool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"build-tool" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"scan-deps" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)),
		String -> Object -> Parser ()
guardCmd String
"scan file" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> BuildTool -> Bool -> Bool -> Command
ScanFile (Path -> BuildTool -> Bool -> Bool -> Command)
-> Parser Path -> Parser (BuildTool -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file" Parser (BuildTool -> Bool -> Bool -> Command)
-> Parser BuildTool -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser BuildTool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"build-tool" Parser BuildTool -> Parser BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BuildTool -> Parser BuildTool
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildTool
CabalTool) Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"scan-project" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"scan-deps" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)),
		String -> Object -> Parser ()
guardCmd String
"scan package-dbs" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (PackageDbStack -> Command
ScanPackageDbs (PackageDbStack -> Command)
-> Parser PackageDbStack -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser PackageDbStack
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"package-db-stack"),
		String -> Object -> Parser ()
guardCmd String
"set-file-contents" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> Maybe Path -> Command
SetFileContents (Path -> Maybe Path -> Command)
-> Parser Path -> Parser (Maybe Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file" Parser (Maybe Path -> Command)
-> Parser (Maybe Path) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser (Maybe Path)
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"contents"),
		String -> Object -> Parser ()
guardCmd String
"docs" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Path] -> [Path] -> Command
RefineDocs ([Path] -> [Path] -> Command)
-> Parser [Path] -> Parser ([Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"projects" Parser ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files"),
		String -> Object -> Parser ()
guardCmd String
"infer" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Path] -> [Path] -> Command
InferTypes ([Path] -> [Path] -> Command)
-> Parser [Path] -> Parser ([Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"projects" Parser ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files"),
		String -> Object -> Parser ()
guardCmd String
"remove" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Path] -> Bool -> [Path] -> [Path] -> Command
Remove ([Path] -> Bool -> [Path] -> [Path] -> Command)
-> Parser [Path] -> Parser (Bool -> [Path] -> [Path] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"projects" Parser (Bool -> [Path] -> [Path] -> Command)
-> Parser Bool -> Parser ([Path] -> [Path] -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			(Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"cabal" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser ([Path] -> [Path] -> Command)
-> Parser [Path] -> Parser ([Path] -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"sandboxes" Parser ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
			Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files"),
		String -> Object -> Parser ()
guardCmd String
"remove-all" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
RemoveAll,
		String -> Object -> Parser ()
guardCmd String
"packages" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
InfoPackages,
		String -> Object -> Parser ()
guardCmd String
"projects" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
InfoProjects,
		String -> Object -> Parser ()
guardCmd String
"sandboxes" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
InfoSandboxes,
		String -> Object -> Parser ()
guardCmd String
"symbol" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command
InfoSymbol (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command)
-> Parser SearchQuery
-> Parser ([TargetFilter] -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser SearchQuery
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"query" Parser ([TargetFilter] -> Bool -> Bool -> Command)
-> Parser [TargetFilter] -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser [TargetFilter]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"filters" Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"header" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"locals" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
		String -> Object -> Parser ()
guardCmd String
"module" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command
InfoModule (SearchQuery -> [TargetFilter] -> Bool -> Bool -> Command)
-> Parser SearchQuery
-> Parser ([TargetFilter] -> Bool -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser SearchQuery
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"query" Parser ([TargetFilter] -> Bool -> Bool -> Command)
-> Parser [TargetFilter] -> Parser (Bool -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser [TargetFilter]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"filters" Parser (Bool -> Bool -> Command)
-> Parser Bool -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"header" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"inspection"),
		String -> Object -> Parser ()
guardCmd String
"project" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Either Path Path -> Command
InfoProject (Either Path Path -> Command)
-> Parser (Either Path Path) -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser (Either Path Path)] -> Parser (Either Path Path)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Path -> Either Path Path
forall a b. a -> Either a b
Left (Path -> Either Path Path)
-> Parser Path -> Parser (Either Path Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"name", Path -> Either Path Path
forall a b. b -> Either a b
Right (Path -> Either Path Path)
-> Parser Path -> Parser (Either Path Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"path"]),
		String -> Object -> Parser ()
guardCmd String
"sandbox" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> Command
InfoSandbox (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"path"),
		String -> Object -> Parser ()
guardCmd String
"lookup" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> Path -> Command
Lookup (Path -> Path -> Command)
-> Parser Path -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"name" Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"whois" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> Path -> Command
Whois (Path -> Path -> Command)
-> Parser Path -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"name" Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"whoat" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Int -> Path -> Command
Whoat (Int -> Int -> Path -> Command)
-> Parser Int -> Parser (Int -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"line" Parser (Int -> Path -> Command)
-> Parser Int -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"column" Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"scope modules" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SearchQuery -> Path -> Command
ResolveScopeModules (SearchQuery -> Path -> Command)
-> Parser SearchQuery -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser SearchQuery
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"query" Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"scope" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SearchQuery -> Path -> Command
ResolveScope (SearchQuery -> Path -> Command)
-> Parser SearchQuery -> Parser (Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser SearchQuery
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"query" Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"usages" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Int -> Path -> Command
FindUsages (Int -> Int -> Path -> Command)
-> Parser Int -> Parser (Int -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"line" Parser (Int -> Path -> Command)
-> Parser Int -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"column" Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"complete" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> Bool -> Path -> Command
Complete (Path -> Bool -> Path -> Command)
-> Parser Path -> Parser (Bool -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"prefix" Parser (Bool -> Path -> Command)
-> Parser Bool -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"wide" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"hayoo" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Int -> Int -> Command
Hayoo (String -> Int -> Int -> Command)
-> Parser String -> Parser (Int -> Int -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"query" Parser (Int -> Int -> Command)
-> Parser Int -> Parser (Int -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"page" Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) Parser (Int -> Command) -> Parser Int -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Int
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"pages" Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1)),
		String -> Object -> Parser ()
guardCmd String
"cabal list" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Path] -> Command
CabalList ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"packages"),
		String -> Object -> Parser ()
guardCmd String
"unresolveds" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Path] -> Command
UnresolvedSymbols ([Path] -> Command) -> Parser [Path] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [Path]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files"),
		String -> Object -> Parser ()
guardCmd String
"lint" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([FileSource] -> FormatFlags -> Command
Lint ([FileSource] -> FormatFlags -> Command)
-> Parser [FileSource] -> Parser (FormatFlags -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [FileSource]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files" Parser (FormatFlags -> Command)
-> Parser FormatFlags -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"lint-opts"),
		String -> Object -> Parser ()
guardCmd String
"check" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([FileSource] -> FormatFlags -> Bool -> Command
Check ([FileSource] -> FormatFlags -> Bool -> Command)
-> Parser [FileSource] -> Parser (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [FileSource]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files" Parser (FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"ghc-opts" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"clear" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
		String -> Object -> Parser ()
guardCmd String
"check-lint" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([FileSource] -> FormatFlags -> FormatFlags -> Bool -> Command
CheckLint ([FileSource] -> FormatFlags -> FormatFlags -> Bool -> Command)
-> Parser [FileSource]
-> Parser (FormatFlags -> FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [FileSource]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files" Parser (FormatFlags -> FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"ghc-opts" Parser (FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"lint-opts" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"clear" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
		String -> Object -> Parser ()
guardCmd String
"types" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([FileSource] -> FormatFlags -> Bool -> Command
Types ([FileSource] -> FormatFlags -> Bool -> Command)
-> Parser [FileSource] -> Parser (FormatFlags -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [FileSource]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"files" Parser (FormatFlags -> Bool -> Command)
-> Parser FormatFlags -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"ghc-opts" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"clear" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
		String -> Object -> Parser ()
guardCmd String
"autofixes" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Note OutputMessage] -> Command
AutoFix ([Note OutputMessage] -> Command)
-> Parser [Note OutputMessage] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [Note OutputMessage]
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"messages"),
		String -> Object -> Parser ()
guardCmd String
"refactor" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Note Refact] -> [Note Refact] -> Bool -> Command
Refactor ([Note Refact] -> [Note Refact] -> Bool -> Command)
-> Parser [Note Refact]
-> Parser ([Note Refact] -> Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser [Note Refact]
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"messages" Parser ([Note Refact] -> Bool -> Command)
-> Parser [Note Refact] -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser [Note Refact]
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"rest" Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"pure" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)),
		String -> Object -> Parser ()
guardCmd String
"rename" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Path -> Path -> Maybe (Int, Int) -> Path -> Command
Rename (Path -> Path -> Maybe (Int, Int) -> Path -> Command)
-> Parser Path
-> Parser (Path -> Maybe (Int, Int) -> Path -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"name" Parser (Path -> Maybe (Int, Int) -> Path -> Command)
-> Parser Path -> Parser (Maybe (Int, Int) -> Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"new-name" Parser (Maybe (Int, Int) -> Path -> Command)
-> Parser (Maybe (Int, Int)) -> Parser (Path -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int -> Int -> (Int, Int))
-> Maybe Int -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Maybe Int -> Maybe Int -> Maybe (Int, Int))
-> Parser (Maybe Int) -> Parser (Maybe Int -> Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Path -> Parser (Maybe a)
.::? Path
"line" Parser (Maybe Int -> Maybe (Int, Int))
-> Parser (Maybe Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Path -> Parser (Maybe a)
.::? Path
"column") Parser (Path -> Command) -> Parser Path -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"ghc eval" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FormatFlags -> Maybe FileSource -> Command
GhcEval (FormatFlags -> Maybe FileSource -> Command)
-> Parser FormatFlags -> Parser (Maybe FileSource -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"exprs" Parser (Maybe FileSource -> Command)
-> Parser (Maybe FileSource) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser (Maybe FileSource)
forall a. FromJSON a => Object -> Path -> Parser (Maybe a)
.::? Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"ghc type" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FormatFlags -> Maybe FileSource -> Command
GhcType (FormatFlags -> Maybe FileSource -> Command)
-> Parser FormatFlags -> Parser (Maybe FileSource -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser FormatFlags
forall a. FromJSON a => Object -> Path -> Parser [a]
.::?! Path
"exprs" Parser (Maybe FileSource -> Command)
-> Parser (Maybe FileSource) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser (Maybe FileSource)
forall a. FromJSON a => Object -> Path -> Parser (Maybe a)
.::? Path
"file"),
		String -> Object -> Parser ()
guardCmd String
"langs" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Langs,
		String -> Object -> Parser ()
guardCmd String
"flags" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Flags,
		String -> Object -> Parser ()
guardCmd String
"link" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> Command
Link (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Path -> Parser Bool
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"hold" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
		String -> Object -> Parser ()
guardCmd String
"stop-ghc" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
StopGhc,
		String -> Object -> Parser ()
guardCmd String
"exit" Object
v Parser () -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Exit]

instance ToJSON FileSource where
	toJSON :: FileSource -> Value
toJSON (FileSource Path
fpath Maybe Path
mcts) = [Pair] -> Value
object [Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
fpath, Path
"contents" Path -> Maybe Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Maybe Path
mcts]

instance FromJSON FileSource where
	parseJSON :: Value -> Parser FileSource
parseJSON = String
-> (Object -> Parser FileSource) -> Value -> Parser FileSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"file-contents" ((Object -> Parser FileSource) -> Value -> Parser FileSource)
-> (Object -> Parser FileSource) -> Value -> Parser FileSource
forall a b. (a -> b) -> a -> b
$ \Object
v -> Path -> Maybe Path -> FileSource
FileSource (Path -> Maybe Path -> FileSource)
-> Parser Path -> Parser (Maybe Path -> FileSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file" Parser (Maybe Path -> FileSource)
-> Parser (Maybe Path) -> Parser FileSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser (Maybe Path)
forall a. FromJSON a => Object -> Path -> Parser (Maybe a)
.::? Path
"contents"

instance ToJSON TargetFilter where
	toJSON :: TargetFilter -> Value
toJSON (TargetProject Path
pname) = [Pair] -> Value
object [Path
"project" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
pname]
	toJSON (TargetFile Path
fpath) = [Pair] -> Value
object [Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
fpath]
	toJSON (TargetModule Path
mname) = [Pair] -> Value
object [Path
"module" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
mname]
	toJSON (TargetPackage Path
pkg) = [Pair] -> Value
object [Path
"package" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
pkg]
	toJSON TargetFilter
TargetInstalled = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"installed" :: String)
	toJSON TargetFilter
TargetSourced = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"sourced" :: String)
	toJSON TargetFilter
TargetStandalone = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"standalone" :: String)

instance FromJSON TargetFilter where
	parseJSON :: Value -> Parser TargetFilter
parseJSON Value
j = Value -> Parser TargetFilter
obj Value
j Parser TargetFilter -> Parser TargetFilter -> Parser TargetFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TargetFilter
str' where
		obj :: Value -> Parser TargetFilter
obj = String
-> (Object -> Parser TargetFilter) -> Value -> Parser TargetFilter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"target-filter" ((Object -> Parser TargetFilter) -> Value -> Parser TargetFilter)
-> (Object -> Parser TargetFilter) -> Value -> Parser TargetFilter
forall a b. (a -> b) -> a -> b
$ \Object
v -> [Parser TargetFilter] -> Parser TargetFilter
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
			Path -> TargetFilter
TargetProject (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"project",
			Path -> TargetFilter
TargetFile (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"file",
			Path -> TargetFilter
TargetModule (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"module",
			Path -> TargetFilter
TargetPackage (Path -> TargetFilter) -> Parser Path -> Parser TargetFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"package"]
		str' :: Parser TargetFilter
str' = do
			String
s <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j :: A.Parser String
			case String
s of
				String
"installed" -> TargetFilter -> Parser TargetFilter
forall (m :: * -> *) a. Monad m => a -> m a
return TargetFilter
TargetInstalled
				String
"sourced" -> TargetFilter -> Parser TargetFilter
forall (m :: * -> *) a. Monad m => a -> m a
return TargetFilter
TargetSourced
				String
"standalone" -> TargetFilter -> Parser TargetFilter
forall (m :: * -> *) a. Monad m => a -> m a
return TargetFilter
TargetStandalone
				String
_ -> Parser TargetFilter
forall (f :: * -> *) a. Alternative f => f a
empty

instance ToJSON SearchQuery where
	toJSON :: SearchQuery -> Value
toJSON (SearchQuery Path
q SearchType
st) = [Pair] -> Value
object [Path
"input" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
q, Path
"type" Path -> SearchType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= SearchType
st]

instance FromJSON SearchQuery where
	parseJSON :: Value -> Parser SearchQuery
parseJSON = String
-> (Object -> Parser SearchQuery) -> Value -> Parser SearchQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"search-query" ((Object -> Parser SearchQuery) -> Value -> Parser SearchQuery)
-> (Object -> Parser SearchQuery) -> Value -> Parser SearchQuery
forall a b. (a -> b) -> a -> b
$ \Object
v -> Path -> SearchType -> SearchQuery
SearchQuery (Path -> SearchType -> SearchQuery)
-> Parser Path -> Parser (SearchType -> SearchQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"input" Parser Path -> Parser Path -> Parser Path
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Path -> Parser Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
"") Parser (SearchType -> SearchQuery)
-> Parser SearchType -> Parser SearchQuery
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Path -> Parser SearchType
forall a. FromJSON a => Object -> Path -> Parser a
.:: Path
"type" Parser SearchType -> Parser SearchType -> Parser SearchType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SearchType -> Parser SearchType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchType
SearchPrefix)

instance ToJSON SearchType where
	toJSON :: SearchType -> Value
toJSON SearchType
SearchExact = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"exact" :: String)
	toJSON SearchType
SearchPrefix = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"prefix" :: String)
	toJSON SearchType
SearchInfix = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"infix" :: String)
	toJSON SearchType
SearchSuffix = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"suffix" :: String)

instance FromJSON SearchType where
	parseJSON :: Value -> Parser SearchType
parseJSON Value
v = do
		String
str' <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: A.Parser String
		case String
str' of
			String
"exact" -> SearchType -> Parser SearchType
forall (m :: * -> *) a. Monad m => a -> m a
return SearchType
SearchExact
			String
"prefix" -> SearchType -> Parser SearchType
forall (m :: * -> *) a. Monad m => a -> m a
return SearchType
SearchPrefix
			String
"infix" -> SearchType -> Parser SearchType
forall (m :: * -> *) a. Monad m => a -> m a
return SearchType
SearchInfix
			String
"suffix" -> SearchType -> Parser SearchType
forall (m :: * -> *) a. Monad m => a -> m a
return SearchType
SearchInfix
			String
_ -> Parser SearchType
forall (f :: * -> *) a. Alternative f => f a
empty