{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}

module Ide.Plugin.Splice.Types where

import           Data.Aeson                 (FromJSON, ToJSON)
import qualified Data.Text                  as T
import           Development.IDE            (Uri)
import           Development.IDE.GHC.Compat (RealSrcSpan)
import           GHC.Generics               (Generic)
import           Ide.Types                  (CommandId)

-- | Parameter for the addMethods PluginCommand.
data ExpandSpliceParams = ExpandSpliceParams
    { ExpandSpliceParams -> Uri
uri           :: Uri
    , ExpandSpliceParams -> RealSrcSpan
spliceSpan    :: RealSrcSpan
    , ExpandSpliceParams -> SpliceContext
spliceContext :: SpliceContext
    }
    deriving (Int -> ExpandSpliceParams -> ShowS
[ExpandSpliceParams] -> ShowS
ExpandSpliceParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpandSpliceParams] -> ShowS
$cshowList :: [ExpandSpliceParams] -> ShowS
show :: ExpandSpliceParams -> String
$cshow :: ExpandSpliceParams -> String
showsPrec :: Int -> ExpandSpliceParams -> ShowS
$cshowsPrec :: Int -> ExpandSpliceParams -> ShowS
Show, ExpandSpliceParams -> ExpandSpliceParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpandSpliceParams -> ExpandSpliceParams -> Bool
$c/= :: ExpandSpliceParams -> ExpandSpliceParams -> Bool
== :: ExpandSpliceParams -> ExpandSpliceParams -> Bool
$c== :: ExpandSpliceParams -> ExpandSpliceParams -> Bool
Eq, forall x. Rep ExpandSpliceParams x -> ExpandSpliceParams
forall x. ExpandSpliceParams -> Rep ExpandSpliceParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExpandSpliceParams x -> ExpandSpliceParams
$cfrom :: forall x. ExpandSpliceParams -> Rep ExpandSpliceParams x
Generic)
    deriving anyclass ([ExpandSpliceParams] -> Encoding
[ExpandSpliceParams] -> Value
ExpandSpliceParams -> Encoding
ExpandSpliceParams -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExpandSpliceParams] -> Encoding
$ctoEncodingList :: [ExpandSpliceParams] -> Encoding
toJSONList :: [ExpandSpliceParams] -> Value
$ctoJSONList :: [ExpandSpliceParams] -> Value
toEncoding :: ExpandSpliceParams -> Encoding
$ctoEncoding :: ExpandSpliceParams -> Encoding
toJSON :: ExpandSpliceParams -> Value
$ctoJSON :: ExpandSpliceParams -> Value
ToJSON, Value -> Parser [ExpandSpliceParams]
Value -> Parser ExpandSpliceParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExpandSpliceParams]
$cparseJSONList :: Value -> Parser [ExpandSpliceParams]
parseJSON :: Value -> Parser ExpandSpliceParams
$cparseJSON :: Value -> Parser ExpandSpliceParams
FromJSON)

-- FIXME: HsDecl needs different treatment of splicing.
data SpliceContext = Expr | HsDecl | Pat | HsType
    deriving (ReadPrec [SpliceContext]
ReadPrec SpliceContext
Int -> ReadS SpliceContext
ReadS [SpliceContext]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpliceContext]
$creadListPrec :: ReadPrec [SpliceContext]
readPrec :: ReadPrec SpliceContext
$creadPrec :: ReadPrec SpliceContext
readList :: ReadS [SpliceContext]
$creadList :: ReadS [SpliceContext]
readsPrec :: Int -> ReadS SpliceContext
$creadsPrec :: Int -> ReadS SpliceContext
Read, Int -> SpliceContext -> ShowS
[SpliceContext] -> ShowS
SpliceContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpliceContext] -> ShowS
$cshowList :: [SpliceContext] -> ShowS
show :: SpliceContext -> String
$cshow :: SpliceContext -> String
showsPrec :: Int -> SpliceContext -> ShowS
$cshowsPrec :: Int -> SpliceContext -> ShowS
Show, SpliceContext -> SpliceContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpliceContext -> SpliceContext -> Bool
$c/= :: SpliceContext -> SpliceContext -> Bool
== :: SpliceContext -> SpliceContext -> Bool
$c== :: SpliceContext -> SpliceContext -> Bool
Eq, Eq SpliceContext
SpliceContext -> SpliceContext -> Bool
SpliceContext -> SpliceContext -> Ordering
SpliceContext -> SpliceContext -> SpliceContext
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SpliceContext -> SpliceContext -> SpliceContext
$cmin :: SpliceContext -> SpliceContext -> SpliceContext
max :: SpliceContext -> SpliceContext -> SpliceContext
$cmax :: SpliceContext -> SpliceContext -> SpliceContext
>= :: SpliceContext -> SpliceContext -> Bool
$c>= :: SpliceContext -> SpliceContext -> Bool
> :: SpliceContext -> SpliceContext -> Bool
$c> :: SpliceContext -> SpliceContext -> Bool
<= :: SpliceContext -> SpliceContext -> Bool
$c<= :: SpliceContext -> SpliceContext -> Bool
< :: SpliceContext -> SpliceContext -> Bool
$c< :: SpliceContext -> SpliceContext -> Bool
compare :: SpliceContext -> SpliceContext -> Ordering
$ccompare :: SpliceContext -> SpliceContext -> Ordering
Ord, forall x. Rep SpliceContext x -> SpliceContext
forall x. SpliceContext -> Rep SpliceContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpliceContext x -> SpliceContext
$cfrom :: forall x. SpliceContext -> Rep SpliceContext x
Generic)
    deriving anyclass ([SpliceContext] -> Encoding
[SpliceContext] -> Value
SpliceContext -> Encoding
SpliceContext -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SpliceContext] -> Encoding
$ctoEncodingList :: [SpliceContext] -> Encoding
toJSONList :: [SpliceContext] -> Value
$ctoJSONList :: [SpliceContext] -> Value
toEncoding :: SpliceContext -> Encoding
$ctoEncoding :: SpliceContext -> Encoding
toJSON :: SpliceContext -> Value
$ctoJSON :: SpliceContext -> Value
ToJSON, Value -> Parser [SpliceContext]
Value -> Parser SpliceContext
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SpliceContext]
$cparseJSONList :: Value -> Parser [SpliceContext]
parseJSON :: Value -> Parser SpliceContext
$cparseJSON :: Value -> Parser SpliceContext
FromJSON)

data ExpandStyle = Inplace | Commented
    deriving (ReadPrec [ExpandStyle]
ReadPrec ExpandStyle
Int -> ReadS ExpandStyle
ReadS [ExpandStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExpandStyle]
$creadListPrec :: ReadPrec [ExpandStyle]
readPrec :: ReadPrec ExpandStyle
$creadPrec :: ReadPrec ExpandStyle
readList :: ReadS [ExpandStyle]
$creadList :: ReadS [ExpandStyle]
readsPrec :: Int -> ReadS ExpandStyle
$creadsPrec :: Int -> ReadS ExpandStyle
Read, Int -> ExpandStyle -> ShowS
[ExpandStyle] -> ShowS
ExpandStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpandStyle] -> ShowS
$cshowList :: [ExpandStyle] -> ShowS
show :: ExpandStyle -> String
$cshow :: ExpandStyle -> String
showsPrec :: Int -> ExpandStyle -> ShowS
$cshowsPrec :: Int -> ExpandStyle -> ShowS
Show, ExpandStyle -> ExpandStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpandStyle -> ExpandStyle -> Bool
$c/= :: ExpandStyle -> ExpandStyle -> Bool
== :: ExpandStyle -> ExpandStyle -> Bool
$c== :: ExpandStyle -> ExpandStyle -> Bool
Eq, Eq ExpandStyle
ExpandStyle -> ExpandStyle -> Bool
ExpandStyle -> ExpandStyle -> Ordering
ExpandStyle -> ExpandStyle -> ExpandStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExpandStyle -> ExpandStyle -> ExpandStyle
$cmin :: ExpandStyle -> ExpandStyle -> ExpandStyle
max :: ExpandStyle -> ExpandStyle -> ExpandStyle
$cmax :: ExpandStyle -> ExpandStyle -> ExpandStyle
>= :: ExpandStyle -> ExpandStyle -> Bool
$c>= :: ExpandStyle -> ExpandStyle -> Bool
> :: ExpandStyle -> ExpandStyle -> Bool
$c> :: ExpandStyle -> ExpandStyle -> Bool
<= :: ExpandStyle -> ExpandStyle -> Bool
$c<= :: ExpandStyle -> ExpandStyle -> Bool
< :: ExpandStyle -> ExpandStyle -> Bool
$c< :: ExpandStyle -> ExpandStyle -> Bool
compare :: ExpandStyle -> ExpandStyle -> Ordering
$ccompare :: ExpandStyle -> ExpandStyle -> Ordering
Ord, forall x. Rep ExpandStyle x -> ExpandStyle
forall x. ExpandStyle -> Rep ExpandStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExpandStyle x -> ExpandStyle
$cfrom :: forall x. ExpandStyle -> Rep ExpandStyle x
Generic)

expandStyles :: [(ExpandStyle, (T.Text, CommandId))]
expandStyles :: [(ExpandStyle, (Text, CommandId))]
expandStyles =
    [ (ExpandStyle
Inplace, (Text
inplaceCmdName, CommandId
expandInplaceId))
    -- , (Commented, commentedCmdName, expandCommentedId)
    ]

toExpandCmdTitle :: ExpandStyle -> T.Text
toExpandCmdTitle :: ExpandStyle -> Text
toExpandCmdTitle ExpandStyle
Inplace   = Text
inplaceCmdName
toExpandCmdTitle ExpandStyle
Commented = Text
commentedCmdName

toCommandId :: ExpandStyle -> CommandId
toCommandId :: ExpandStyle -> CommandId
toCommandId ExpandStyle
Inplace   = CommandId
expandInplaceId
toCommandId ExpandStyle
Commented = CommandId
expandCommentedId

expandInplaceId, expandCommentedId :: CommandId
expandInplaceId :: CommandId
expandInplaceId = CommandId
"expandTHSpliceInplace"
expandCommentedId :: CommandId
expandCommentedId = CommandId
"expandTHSpliceCommented"

inplaceCmdName :: T.Text
inplaceCmdName :: Text
inplaceCmdName = Text
"expand TemplateHaskell Splice (in-place)"

commentedCmdName :: T.Text
commentedCmdName :: Text
commentedCmdName = Text
"expand TemplateHaskell Splice (commented-out)"