diff --git a/argo/src/Argo.hs b/argo/src/Argo.hs index 502d5c3..682edb3 100644 --- a/argo/src/Argo.hs +++ b/argo/src/Argo.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE UndecidableInstances #-} @@ -75,6 +76,7 @@ module Argo -- * AppMethod info methodName, methodParamDocs, + methodReturnFieldDocs, methodDocs ) where @@ -210,6 +212,7 @@ data AppCommand appState = { commandName :: !Text , commandImplementation :: !(JSON.Value -> Command appState JSON.Value) , commandParamDocs :: ![(Text, Doc.Block)] + , commandReturnFieldDocs :: ![(Text, Doc.Block)] , commandDocs :: !Doc.Block } @@ -218,6 +221,7 @@ data AppQuery appState = { queryName :: !Text , queryImplementation :: !(JSON.Value -> Query appState JSON.Value) , queryParamDocs :: ![(Text, Doc.Block)] + , queryReturnFieldDocs :: ![(Text, Doc.Block)] , queryDocs :: !Doc.Block } @@ -249,6 +253,11 @@ methodParamDocs (CommandMethod m) = commandParamDocs m methodParamDocs (QueryMethod m) = queryParamDocs m methodParamDocs (NotificationMethod m) = notificationParamDocs m +methodReturnFieldDocs :: AppMethod appState -> [(Text, Doc.Block)] +methodReturnFieldDocs (CommandMethod m) = commandReturnFieldDocs m +methodReturnFieldDocs (QueryMethod m) = queryReturnFieldDocs m +methodReturnFieldDocs NotificationMethod{} = [] + methodDocs :: AppMethod appState -> Doc.Block methodDocs (CommandMethod m) = commandDocs m methodDocs (QueryMethod m) = queryDocs m @@ -262,7 +271,7 @@ methodDocs (NotificationMethod m) = notificationDocs m -- exception. command :: forall params result state. - (JSON.FromJSON params, Doc.DescribedParams params, JSON.ToJSON result) => + (JSON.FromJSON params, Doc.DescribedMethod params result, JSON.ToJSON result) => Text -> Doc.Block -> (params -> Command state result) -> @@ -277,6 +286,7 @@ command name doc f = { commandName = name , commandImplementation = impl , commandParamDocs = Doc.parameterFieldDescription @params + , commandReturnFieldDocs = Doc.resultFieldDescription @params @result , commandDocs = doc } @@ -287,7 +297,7 @@ command name doc f = -- exception. query :: forall params result state. - (JSON.FromJSON params, Doc.DescribedParams params, JSON.ToJSON result) => + (JSON.FromJSON params, Doc.DescribedMethod params result, JSON.ToJSON result) => Text -> Doc.Block -> (params -> Query state result) -> @@ -302,6 +312,7 @@ query name doc f = { queryName = name , queryImplementation = impl , queryParamDocs = Doc.parameterFieldDescription @params + , queryReturnFieldDocs = Doc.resultFieldDescription @params @result , queryDocs = doc } @@ -312,7 +323,7 @@ query name doc f = -- exception. notification :: forall params state. - (JSON.FromJSON params, Doc.DescribedParams params) => + (JSON.FromJSON params, Doc.DescribedMethod params ()) => Text -> Doc.Block -> (params -> Notification ()) -> @@ -439,13 +450,23 @@ mkApp name docs opts initAppState methods = do docs ++ [Doc.Section "Methods" [ Doc.Section (methodName m <> " (" <> methodKind m <> ")") - [ if null (methodParamDocs m) - then Doc.Paragraph [Doc.Text "No parameters"] - else Doc.DescriptionList - [ (Doc.Literal field :| [], fieldDocs) - | (field, fieldDocs) <- (methodParamDocs m) - ] - , (methodDocs m) + [ methodDocs m + , Doc.Section "Parameter fields" + [ if null (methodParamDocs m) + then Doc.Paragraph [Doc.Text "No parameters"] + else Doc.DescriptionList + [ (Doc.Literal field :| [], fieldDocs) + | (field, fieldDocs) <- methodParamDocs m + ] + ] + , Doc.Section "Return fields" + [ if null (methodReturnFieldDocs m) + then Doc.Paragraph [Doc.Text "No return fields"] + else Doc.DescriptionList + [ (Doc.Literal field :| [], fieldDocs) + | (field, fieldDocs) <- methodReturnFieldDocs m + ] + ] ] | m <- methods ]] diff --git a/argo/src/Argo/Doc.hs b/argo/src/Argo/Doc.hs index 0190814..ca46b75 100644 --- a/argo/src/Argo/Doc.hs +++ b/argo/src/Argo/Doc.hs @@ -1,8 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -module Argo.Doc (LinkTarget(..), Block(..), Inline(..), Described(..), DescribedParams(..), datatype) where +module Argo.Doc (LinkTarget(..), Block(..), Inline(..), Described(..), DescribedMethod(..), datatype) where import Data.List.NonEmpty import Data.Text (Text) @@ -35,14 +38,37 @@ class Described a where description :: [Block] --- | This class provides the canonical documentation for a datatype --- that is deserialized as parameters to some method via a @FromJSON@ --- instance. The type variable does not occur in the method's --- signature because it is intended to be used with the --- @TypeApplications@ extension to GHC Haskell. -class DescribedParams a where +-- | This class provides the canonical documentation for a pair of datatypes, +-- where: +-- +-- * The first datatype (@params@) is deserialized as parameters to some method +-- via a @FromJSON@ instance, and +-- +-- * The second datatype (@result@) is serialized as the result returned by the +-- same method via a @ToJSON@ instance. +-- +-- The @params@ type is almost always a custom data type defined for the +-- purpose of interfacing with RPC, which is why @result@ has a functional +-- dependency on @params@. On the other hand, it is common for @result@ to be +-- off-the-shelf data types such as @Value@ (for methods that return a JSON +-- object) or @()@ (for methods that do not return any values). +-- +-- Neither @params@ nor @result@ occur in the signatures of the methods +-- because they are intended to be used with the @TypeApplications@ extension +-- to GHC Haskell. +class DescribedMethod params result | params -> result where + -- | Documentation for the parameters expected by the method. parameterFieldDescription :: [(Text, Block)] + -- | Documentation for the result returned by the method. + -- + -- If the method does not return anything—that is, if @result@ is + -- @()@—then this method does not need to be implemented, as it will be + -- defaulted appropriately. + resultFieldDescription :: [(Text, Block)] + default resultFieldDescription :: (result ~ ()) => [(Text, Block)] + resultFieldDescription = [] + datatype :: forall a . (Typeable a, Described a) => Block datatype = Datatype (typeRep (Proxy @a)) (typeName @a) (description @a) diff --git a/file-echo-api/README.rst b/file-echo-api/README.rst index f9488f0..db41ae0 100644 --- a/file-echo-api/README.rst +++ b/file-echo-api/README.rst @@ -93,55 +93,110 @@ Methods load (command) ~~~~~~~~~~~~~~ +Load a file from disk into memory. + +Parameter fields +++++++++++++++++ + ``file path`` The file to read into memory. -Load a file from disk into memory. + +Return fields ++++++++++++++ + +No return fields + clear (command) ~~~~~~~~~~~~~~~ +Forget the loaded file. + +Parameter fields +++++++++++++++++ + No parameters -Forget the loaded file. + +Return fields ++++++++++++++ + +No return fields + prepend (command) ~~~~~~~~~~~~~~~~~ +Append a string to the left of the current contents. + +Parameter fields +++++++++++++++++ + ``content`` The string to append to the left of the current file content on the server. -Append a string to the left of the current contents. + +Return fields ++++++++++++++ + +No return fields + drop (command) ~~~~~~~~~~~~~~ +Drop from the left of the current contents. + +Parameter fields +++++++++++++++++ + ``count`` The number of characters to drop from the left of the current file content on the server. -Drop from the left of the current contents. + +Return fields ++++++++++++++ + +No return fields + implode (query) ~~~~~~~~~~~~~~~ +Throw an error immediately. + +Parameter fields +++++++++++++++++ + No parameters -Throw an error immediately. + +Return fields ++++++++++++++ + +No return fields + show (query) ~~~~~~~~~~~~ +Show a substring of the file. + +Parameter fields +++++++++++++++++ + ``start`` Start index (inclusive). If not provided, the substring is from the beginning of the file. @@ -152,37 +207,75 @@ show (query) End index (exclusive). If not provided, the remainder of the file is returned. -Show a substring of the file. + +Return fields ++++++++++++++ + + +``value`` + The substring ranging from ``start`` to ``end``. + + ignore (query) ~~~~~~~~~~~~~~ +Ignore an :ref:`ignorable value `. + +Parameter fields +++++++++++++++++ + ``to be ignored`` The value to be ignored goes here. -Ignore an :ref:`ignorable value `. + +Return fields ++++++++++++++ + +No return fields + destroy state (notification) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Destroy a state in the server. + +Parameter fields +++++++++++++++++ + ``state to destroy`` The state to destroy in the server (so it can be released from memory). -Destroy a state in the server. + +Return fields ++++++++++++++ + +No return fields + destroy all states (notification) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Destroy all states in the server. + +Parameter fields +++++++++++++++++ + No parameters -Destroy all states in the server. + +Return fields ++++++++++++++ + +No return fields + diff --git a/file-echo-api/src/FileEchoServer.hs b/file-echo-api/src/FileEchoServer.hs index 32676fc..2333675 100644 --- a/file-echo-api/src/FileEchoServer.hs +++ b/file-echo-api/src/FileEchoServer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} module FileEchoServer ( module FileEchoServer ) where @@ -58,7 +59,7 @@ instance JSON.FromJSON LoadParams where JSON.withObject "params for \"load\"" $ \o -> LoadParams <$> o .: "file path" -instance Doc.DescribedParams LoadParams where +instance Doc.DescribedMethod LoadParams () where parameterFieldDescription = [("file path", Doc.Paragraph [Doc.Text "The file to read into memory."])] @@ -86,7 +87,7 @@ instance JSON.FromJSON PrependParams where JSON.withObject "params for \"prepend\"" $ \o -> PrependParams <$> o .: "content" -instance Doc.DescribedParams PrependParams where +instance Doc.DescribedMethod PrependParams () where parameterFieldDescription = [("content", Doc.Paragraph [Doc.Text "The string to append to the left of the current file content on the server."])] @@ -109,7 +110,7 @@ instance JSON.FromJSON DropParams where JSON.withObject "params for \"drop\"" $ \o -> DropParams <$> o .: "count" -instance Doc.DescribedParams DropParams where +instance Doc.DescribedMethod DropParams () where parameterFieldDescription = [("count", Doc.Paragraph [Doc.Text "The number of characters to drop from the left of the current file content on the server."])] @@ -132,7 +133,7 @@ instance JSON.FromJSON ClearParams where JSON.withObject "params for \"show\"" $ \_ -> pure ClearParams -instance Doc.DescribedParams ClearParams where +instance Doc.DescribedMethod ClearParams () where parameterFieldDescription = [] clearCmd :: ClearParams -> Argo.Command ServerState () @@ -159,13 +160,20 @@ instance JSON.FromJSON ShowParams where end <- o .:? "end" pure $ ShowParams start end -instance Doc.DescribedParams ShowParams where +instance Doc.DescribedMethod ShowParams JSON.Value where parameterFieldDescription = [ ("start", Doc.Paragraph [Doc.Text "Start index (inclusive). If not provided, the substring is from the beginning of the file."]) , ("end", Doc.Paragraph [Doc.Text "End index (exclusive). If not provided, the remainder of the file is returned."]) ] + resultFieldDescription = + [ ("value", + Doc.Paragraph [ Doc.Text "The substring ranging from " + , Doc.Literal "start", Doc.Text " to ", Doc.Literal "end" + , Doc.Text "." ]) + ] + showCmd :: ShowParams -> Argo.Query ServerState JSON.Value showCmd (ShowParams start end) = @@ -186,7 +194,7 @@ instance JSON.FromJSON ImplodeParams where JSON.withObject "params for \"implode\"" $ \_ -> pure ImplodeParams -instance Doc.DescribedParams ImplodeParams where +instance Doc.DescribedMethod ImplodeParams () where parameterFieldDescription = [] @@ -229,7 +237,7 @@ instance JSON.FromJSON IgnoreParams where JSON.withObject "params for \"ignore\"" $ \o -> IgnoreParams <$> o .: "to be ignored" -instance Doc.DescribedParams IgnoreParams where +instance Doc.DescribedMethod IgnoreParams () where parameterFieldDescription = [("to be ignored", Doc.Paragraph [Doc.Text "The value to be ignored goes here."])] @@ -251,8 +259,8 @@ instance JSON.FromJSON DestroyStateParams where JSON.withObject "params for \"destroy state\"" $ \o -> DestroyStateParams <$> o .: "state to destroy" -instance Doc.DescribedParams DestroyStateParams where - parameterFieldDescription = +instance Doc.DescribedMethod DestroyStateParams () where + parameterFieldDescription = [("state to destroy", Doc.Paragraph [Doc.Text "The state to destroy in the server (so it can be released from memory)."]) ] @@ -271,7 +279,7 @@ instance JSON.FromJSON DestroyAllStatesParams where JSON.withObject "params for \"destroy all states\"" $ \_ -> pure DestroyAllStatesParams -instance Doc.DescribedParams DestroyAllStatesParams where +instance Doc.DescribedMethod DestroyAllStatesParams () where parameterFieldDescription = [] diff --git a/file-echo-api/src/MutableFileEchoServer.hs b/file-echo-api/src/MutableFileEchoServer.hs index e4f1fa2..3839cdd 100644 --- a/file-echo-api/src/MutableFileEchoServer.hs +++ b/file-echo-api/src/MutableFileEchoServer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {- Like FileEchoServer but the underlying state uses mutability to update the loaded file contents. -} @@ -32,7 +33,7 @@ initialState :: initialState Nothing _reader = do contentRef <- newIORef (FileContents "") pure $ ServerState Nothing contentRef -initialState (Just path) reader = do +initialState (Just path) reader = do contents <- FileContents . Char8.unpack <$> reader path contentRef <- newIORef contents pure $ ServerState (Just path) contentRef @@ -62,7 +63,7 @@ instance JSON.FromJSON LoadParams where JSON.withObject "params for \"load\"" $ \o -> LoadParams <$> o .: "file path" -instance Doc.DescribedParams LoadParams where +instance Doc.DescribedMethod LoadParams () where parameterFieldDescription = [("file path", Doc.Paragraph [Doc.Text "The file to read into memory."])] @@ -89,7 +90,7 @@ instance JSON.FromJSON ClearParams where JSON.withObject "params for \"show\"" $ \_ -> pure ClearParams -instance Doc.DescribedParams ClearParams where +instance Doc.DescribedMethod ClearParams () where parameterFieldDescription = [] clearCmd :: ClearParams -> Argo.Command ServerState () @@ -115,13 +116,20 @@ instance JSON.FromJSON ShowParams where end <- o .:? "end" pure $ ShowParams start end -instance Doc.DescribedParams ShowParams where +instance Doc.DescribedMethod ShowParams JSON.Value where parameterFieldDescription = [ ("start", Doc.Paragraph [Doc.Text "Start index (inclusive). If not provided, the substring is from the beginning of the file."]) , ("end", Doc.Paragraph [Doc.Text "End index (exclusive). If not provided, the remainder of the file is returned."]) ] + resultFieldDescription = + [ ("value", + Doc.Paragraph [ Doc.Text "The substring ranging from " + , Doc.Literal "start", Doc.Text " to ", Doc.Literal "end" + , Doc.Text "." ]) + ] + showCmd :: ShowParams -> Argo.Query ServerState JSON.Value showCmd (ShowParams start end) = do @@ -145,8 +153,8 @@ instance JSON.FromJSON DestroyStateParams where JSON.withObject "params for \"destroy state\"" $ \o -> DestroyStateParams <$> o .: "state to destroy" -instance Doc.DescribedParams DestroyStateParams where - parameterFieldDescription = +instance Doc.DescribedMethod DestroyStateParams () where + parameterFieldDescription = [("state to destroy", Doc.Paragraph [Doc.Text "The state to destroy in the server (so it can be released from memory)."]) ]