packages feed

opencode (empty) → 0.1.0.0

raw patch · 4 files changed

+686/−0 lines, 4 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, http-api-data, http-client, http-client-tls, http-types, mtl, relude, servant, servant-client, servant-client-core, text

Files

+ opencode.cabal view
@@ -0,0 +1,66 @@+cabal-version: 2.4+name:          opencode+version:       0.1.0.0+license:       MIT+copyright:     2026 Sridhar Ratnakumar+maintainer:    srid@srid.ca+author:        Sridhar Ratnakumar+category:      Web+homepage:      https://github.com/anomalyco/opencode+synopsis:      Haskell client library for OpenCode server API++common shared+  ghc-options:+    -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns+    -Wmissing-deriving-strategies -Wunused-foralls -Wunused-foralls+    -fprint-explicit-foralls -fprint-explicit-kinds++  mixins:+    base hiding (Prelude),+    relude (Relude as Prelude, Relude.Container.One),+    relude++  default-extensions:+    DataKinds+    DerivingStrategies+    DerivingVia+    DuplicateRecordFields+    LambdaCase+    MultiWayIf+    NoStarIsType+    OverloadedRecordDot+    OverloadedStrings+    StrictData+    TypeFamilies+    ViewPatterns++  build-depends:+    , aeson+    , base    >=4   && <5+    , relude  >=1.0++  default-language:   GHC2021++library+  import:          shared+  exposed-modules:+    OpenCode+    OpenCode.Client+    OpenCode.Types++  build-depends:+    , aeson+    , base+    , bytestring+    , http-api-data+    , http-client+    , http-client-tls+    , http-types+    , mtl+    , relude+    , servant+    , servant-client+    , servant-client-core+    , text++  hs-source-dirs:  src
+ src/OpenCode.hs view
@@ -0,0 +1,38 @@+{- |+Module      : OpenCode+Description : Haskell client library for OpenCode server API+Copyright   : (c) 2026 Sridhar Ratnakumar+License     : MIT+Maintainer  : srid@srid.ca+Stability   : experimental++This library provides a type-safe Haskell client for the OpenCode server API.+It uses servant-client for type-safe HTTP requests.++==== Basic Usage++@+import OpenCode++main :: IO ()+main = do+  client <- mkClient "localhost" 4096++  -- Check server health+  health <- getHealth client+  print health++  -- Create a session and send a message+  session <- createSession client Nothing (SessionCreateInput Nothing Nothing)+  response <- sendMessage client session.id Nothing (MessageInput [textPartInput "Hello!"])+  print response+@+-}+module OpenCode (+  module OpenCode.Types,+  module OpenCode.Client,+)+where++import OpenCode.Client+import OpenCode.Types
+ src/OpenCode/Client.hs view
@@ -0,0 +1,150 @@+{- |+Module      : OpenCode.Client+Description : HTTP client for OpenCode server API+Copyright   : (c) 2026 Sridhar Ratnakumar+License     : MIT+Maintainer  : srid@srid.ca+Stability   : experimental++This module provides the HTTP client for interacting with the OpenCode server.+-}+module OpenCode.Client (+  OpenCodeClient (..),+  mkClient,+)+where++import Network.HTTP.Client (defaultManagerSettings, newManager)+import Servant.API (Capture, Delete, Get, JSON, Post, QueryParam, ReqBody, (:<|>) (..), type (:>))+import Servant.Client (BaseUrl (..), ClientEnv, ClientError, Scheme (..), client, mkClientEnv, runClientM)++import OpenCode.Types++-- | Health check endpoint.+type HealthAPI = "global" :> "health" :> Get '[JSON] Health++-- | Sub-routes for a specific session ID.+type SessionMemberAPI =+  Get '[JSON] Session+    :<|> Delete '[JSON] Bool+    :<|> "message" :> QueryParam "directory" FilePath :> ReqBody '[JSON] MessageInput :> Post '[JSON] MessageResponse++-- | Grouped Session routes.+type SessionAPI =+  QueryParam "directory" FilePath :> Get '[JSON] [Session]+    :<|> QueryParam "directory" FilePath :> ReqBody '[JSON] SessionCreateInput :> Post '[JSON] Session+    :<|> Capture "sessionID" SessionID :> QueryParam "directory" FilePath :> SessionMemberAPI++-- | Grouped Project routes.+type ProjectAPI =+  Get '[JSON] [Project]+    :<|> "current" :> Get '[JSON] Project++-- | Server configuration endpoint.+type ConfigAPI = "config" :> Get '[JSON] Config++-- | Provider listing endpoint.+type ProviderAPI = "provider" :> Get '[JSON] ProvidersResponse++-- | Combined OpenCode API.+type OpenCodeAPI =+  HealthAPI+    :<|> "session" :> SessionAPI+    :<|> "project" :> ProjectAPI+    :<|> ConfigAPI+    :<|> ProviderAPI++apiProxy :: Proxy OpenCodeAPI+apiProxy = Proxy++{- | A client for interacting with the OpenCode server API.++Create a client using 'mkClient', then use the record fields to make API calls.++>>> client <- mkClient "localhost" 4096+>>> getHealth client+Right (Health {healthy = True})+-}+data OpenCodeClient = OpenCodeClient+  { getHealth :: IO (Either ClientError Health)+  -- ^ Check if the server is healthy. Calls @GET \/global\/health@.+  , listSessions :: Maybe FilePath -> IO (Either ClientError [Session])+  {- ^ List all sessions.++  The @FilePath@ argument filters by working directory context.+  Pass 'Nothing' to list all sessions regardless of directory.+  -}+  , createSession :: Maybe FilePath -> SessionCreateInput -> IO (Either ClientError Session)+  {- ^ Create a new session.++  The @FilePath@ argument sets the working directory context for the session.+  This determines which project/files the LLM will operate on.+  Pass 'Nothing' to use the server's current directory.+  -}+  , getSession :: SessionID -> Maybe FilePath -> IO (Either ClientError Session)+  -- ^ Get a session by ID. The @FilePath@ is the working directory context.+  , deleteSession :: SessionID -> Maybe FilePath -> IO (Either ClientError Bool)+  -- ^ Delete a session by ID. The @FilePath@ is the working directory context.+  , sendMessage :: SessionID -> Maybe FilePath -> MessageInput -> IO (Either ClientError MessageResponse)+  {- ^ Send a message to a session.++  The @FilePath@ argument is the working directory context for the request.+  Pass 'Nothing' to use the session's existing directory.+  -}+  , listProjects :: IO (Either ClientError [Project])+  -- ^ List all projects. Calls @GET \/project@.+  , getCurrentProject :: IO (Either ClientError Project)+  -- ^ Get the current project. Calls @GET \/project\/current@.+  , getConfig :: IO (Either ClientError Config)+  -- ^ Get the server configuration. Calls @GET \/config@.+  , listProviders :: IO (Either ClientError ProvidersResponse)+  -- ^ List all AI providers. Calls @GET \/provider@.+  , clientEnv :: ClientEnv+  -- ^ The underlying servant client environment (for advanced usage).+  }++{- | Create a new OpenCode client.++>>> client <- mkClient "localhost" 4096+>>> getHealth client+Right (Health {healthy = True})++The client uses HTTP (not HTTPS). For HTTPS, you would need to modify+the client to use 'tlsManagerSettings' and 'Https' scheme.+-}+mkClient :: Text -> Int -> IO OpenCodeClient+mkClient host port = do+  manager <- newManager defaultManagerSettings+  let baseUrl = BaseUrl Http (toString host) port ""+      env = mkClientEnv manager baseUrl+      ( healthH+          :<|> ( sessionListH+                   :<|> sessionCreateH+                   :<|> sessionMemberH+                 )+          :<|> ( projectListH+                   :<|> projectCurrentH+                 )+          :<|> configH+          :<|> providerH+        ) = client apiProxy+  pure+    OpenCodeClient+      { getHealth = runClientM healthH env+      , listSessions = \dir -> runClientM (sessionListH dir) env+      , createSession = \dir input -> runClientM (sessionCreateH dir input) env+      , getSession = \sid dir ->+          let (getH :<|> _ :<|> _) = sessionMemberH sid dir+           in runClientM getH env+      , deleteSession = \sid dir ->+          let (_ :<|> deleteH :<|> _) = sessionMemberH sid dir+           in runClientM deleteH env+      , sendMessage = \sid dir input ->+          let (_ :<|> _ :<|> msgH) = sessionMemberH sid dir+           in runClientM (msgH dir input) env+      , listProjects = runClientM projectListH env+      , getCurrentProject = runClientM projectCurrentH env+      , getConfig = runClientM configH env+      , listProviders = runClientM providerH env+      , clientEnv = env+      }
+ src/OpenCode/Types.hs view
@@ -0,0 +1,432 @@+{- |+Module      : OpenCode.Types+Description : Types for OpenCode server API+Copyright   : (c) 2026 Sridhar Ratnakumar+License     : MIT+Maintainer  : srid@srid.ca+Stability   : experimental++This module provides the data types used by the OpenCode server API.+All types derive 'FromJSON' and 'ToJSON' for serialization.+-}+module OpenCode.Types (+  -- * IDs+  SessionID (..),+  MessageID (..),+  ProjectID (..),+  ProviderID (..),+  PartID (..),+  WorkspaceID (..),+  ModelID (..),++  -- * Core types+  Health (..),+  Session (..),+  SessionTime (..),+  SessionSummary (..),+  Message (..),+  UserMessage (..),+  AssistantMessage (..),+  TextPart (..),+  TextPartInput (..),+  textPartInput,+  Part (..),+  MessageInput (..),+  MessageResponse (..),+  SessionCreateInput (..),+  Project (..),+  Config (..),+  Provider (..),+  ProvidersResponse (..),+)+where++import Data.Aeson (FromJSON (..), FromJSONKey, Options (..), ToJSON (..), ToJSONKey, Value, defaultOptions, genericParseJSON, genericToJSON, withObject, (.:), (.:?))+import Data.Map.Strict qualified as Map+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))++jsonOptions :: Options+jsonOptions = defaultOptions {fieldLabelModifier = Prelude.id}++-- | A session identifier (e.g., @ses_xxx@).+newtype SessionID = SessionID {unSessionID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, ToHttpApiData, FromHttpApiData, FromJSON, ToJSON)++-- | A message identifier (e.g., @msg_xxx@).+newtype MessageID = MessageID {unMessageID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, FromJSON, ToJSON)++-- | A project identifier.+newtype ProjectID = ProjectID {unProjectID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, FromJSON, ToJSON)++-- | A provider identifier (e.g., @openai@, @anthropic@).+newtype ProviderID = ProviderID {unProviderID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, FromJSON, ToJSON, FromJSONKey, ToJSONKey)++-- | A part identifier.+newtype PartID = PartID {unPartID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, FromJSON, ToJSON)++-- | A workspace identifier.+newtype WorkspaceID = WorkspaceID {unWorkspaceID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, FromJSON, ToJSON)++-- | A model identifier (e.g., @litellm/glm-latest@, @openai/gpt-4@).+newtype ModelID = ModelID {unModelID :: Text}+  deriving stock (Show, Eq, Generic)+  deriving newtype (IsString, Ord, ToString, ToText, FromJSON, ToJSON)++-- | Server health status.+newtype Health = Health+  { healthy :: Bool+  -- ^ Whether the server is healthy.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON Health where+  parseJSON = genericParseJSON jsonOptions+instance ToJSON Health where+  toJSON = genericToJSON jsonOptions++-- | Timestamps for a session or message.+data SessionTime = SessionTime+  { created :: Int+  -- ^ Creation timestamp (milliseconds since epoch).+  , updated :: Maybe Int+  -- ^ Last update timestamp.+  , completed :: Maybe Int+  -- ^ Completion timestamp (for messages).+  , compacting :: Maybe Int+  -- ^ Compacting timestamp.+  , archived :: Maybe Int+  -- ^ Archival timestamp.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON SessionTime where+  parseJSON = withObject "SessionTime" $ \v ->+    SessionTime+      <$> v .: "created"+      <*> v .:? "updated"+      <*> v .:? "completed"+      <*> v .:? "compacting"+      <*> v .:? "archived"+instance ToJSON SessionTime where+  toJSON = genericToJSON jsonOptions++-- | Summary of changes in a session.+data SessionSummary = SessionSummary+  { additions :: Int+  -- ^ Number of lines added.+  , deletions :: Int+  -- ^ Number of lines deleted.+  , files :: Int+  -- ^ Number of files modified.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON SessionSummary where+  parseJSON = genericParseJSON jsonOptions+instance ToJSON SessionSummary where+  toJSON = genericToJSON jsonOptions++-- | An OpenCode session.+data Session = Session+  { id :: SessionID+  -- ^ Unique session identifier.+  , slug :: Text+  -- ^ URL-friendly slug.+  , projectID :: ProjectID+  -- ^ ID of the project this session belongs to.+  , workspaceID :: Maybe WorkspaceID+  -- ^ Optional workspace ID.+  , directory :: FilePath+  -- ^ Working directory for the session.+  , parentID :: Maybe SessionID+  -- ^ Parent session ID (for forked sessions).+  , title :: Text+  -- ^ Session title.+  , version :: Text+  -- ^ Session version.+  , time :: SessionTime+  -- ^ Timestamps.+  , summary :: Maybe SessionSummary+  -- ^ Optional summary of changes.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON Session where+  parseJSON = withObject "Session" $ \v ->+    Session+      <$> v .: "id"+      <*> v .: "slug"+      <*> v .: "projectID"+      <*> v .:? "workspaceID"+      <*> v .: "directory"+      <*> v .:? "parentID"+      <*> v .: "title"+      <*> v .: "version"+      <*> v .: "time"+      <*> v .:? "summary"+instance ToJSON Session where+  toJSON = genericToJSON jsonOptions++-- | A text part in a message (from the server).+data TextPart = TextPart+  { id :: Maybe PartID+  -- ^ Optional part ID.+  , text :: Text+  -- ^ The text content.+  , partType :: Maybe Text+  -- ^ The type of part (e.g., @\"text\"@, @\"reasoning\"@).+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON TextPart where+  parseJSON = withObject "TextPart" $ \v ->+    TextPart+      <$> v .:? "id"+      <*> v .: "text"+      <*> v .:? "type"+instance ToJSON TextPart where+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = \case "partType" -> "type"; x -> x}++{- | Input for creating a text part when sending a message.++Use 'textPartInput' to create a text part:++>>> textPartInput "Hello, world!"+TextPartInput {partType = "text", text = "Hello, world!"}+-}+data TextPartInput = TextPartInput+  { partType :: Text+  -- ^ The type of part (should be @\"text\"@).+  , text :: Text+  -- ^ The text content.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON TextPartInput where+  parseJSON = genericParseJSON jsonOptions {fieldLabelModifier = \case "partType" -> "type"; x -> x}+instance ToJSON TextPartInput where+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = \case "partType" -> "type"; x -> x}++{- | Create a text part input for sending a message.++>>> textPartInput "What is 2+2?"+TextPartInput {partType = "text", text = "What is 2+2?"}+-}+textPartInput :: Text -> TextPartInput+textPartInput = TextPartInput "text"++-- | A part of a message (text or other type).+data Part+  = -- | A text part.+    PartText TextPart+  | -- | Some other JSON value (e.g., step-start, step-finish).+    PartOther Value+  deriving stock (Show, Eq, Generic)++instance FromJSON Part where+  parseJSON v =+    withObject+      "Part"+      ( \obj -> do+          partType <- obj .:? "type"+          case partType of+            Just ("text" :: Text) -> PartText <$> parseJSON v+            Just "reasoning" -> PartText <$> parseJSON v+            _ -> pure $ PartOther v+      )+      v+instance ToJSON Part where+  toJSON (PartText p) = toJSON p+  toJSON (PartOther v) = v++-- | A message from the user.+data UserMessage = UserMessage+  { id :: MessageID+  -- ^ Message ID.+  , sessionID :: SessionID+  -- ^ Session ID.+  , parts :: [Part]+  -- ^ Message parts.+  , time :: SessionTime+  -- ^ Timestamps.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON UserMessage where+  parseJSON = withObject "UserMessage" $ \v ->+    UserMessage+      <$> v .: "id"+      <*> v .: "sessionID"+      <*> v .: "parts"+      <*> v .: "time"+instance ToJSON UserMessage where+  toJSON = genericToJSON jsonOptions++-- | A message from the assistant.+data AssistantMessage = AssistantMessage+  { id :: MessageID+  -- ^ Message ID.+  , sessionID :: SessionID+  -- ^ Session ID.+  , time :: Maybe SessionTime+  -- ^ Optional timestamps.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON AssistantMessage where+  parseJSON = withObject "AssistantMessage" $ \v ->+    AssistantMessage+      <$> v .: "id"+      <*> v .: "sessionID"+      <*> v .:? "time"+instance ToJSON AssistantMessage where+  toJSON = genericToJSON jsonOptions++-- | A message (either from user or assistant).+data Message+  = MsgUser UserMessage+  | MsgAssistant AssistantMessage+  deriving stock (Show, Eq, Generic)++instance FromJSON Message where+  parseJSON v = (MsgUser <$> parseJSON v) <|> (MsgAssistant <$> parseJSON v)+instance ToJSON Message where+  toJSON (MsgUser m) = toJSON m+  toJSON (MsgAssistant m) = toJSON m++{- | Input for sending a message.++>>> MessageInput [textPartInput "Hello!"]+MessageInput {parts = [TextPartInput {partType = "text", text = "Hello!"}]}+-}+newtype MessageInput = MessageInput+  { parts :: [TextPartInput]+  -- ^ The parts of the message.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON MessageInput where+  parseJSON = genericParseJSON jsonOptions+instance ToJSON MessageInput where+  toJSON = genericToJSON jsonOptions++-- | Response from sending a message.+data MessageResponse = MessageResponse+  { info :: AssistantMessage+  -- ^ Information about the assistant message.+  , parts :: [Part]+  -- ^ The response parts (text, reasoning, etc.).+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON MessageResponse where+  parseJSON = genericParseJSON jsonOptions+instance ToJSON MessageResponse where+  toJSON = genericToJSON jsonOptions++{- | Input for creating a session.++>>> SessionCreateInput (Just "My Session") Nothing+SessionCreateInput {title = Just "My Session", parentID = Nothing}+-}+data SessionCreateInput = SessionCreateInput+  { title :: Maybe Text+  -- ^ Optional session title.+  , parentID :: Maybe SessionID+  -- ^ Optional parent session ID (for forking).+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON SessionCreateInput where+  parseJSON = withObject "SessionCreateInput" $ \v ->+    SessionCreateInput+      <$> v .:? "title"+      <*> v .:? "parentID"+instance ToJSON SessionCreateInput where+  toJSON = genericToJSON jsonOptions {omitNothingFields = True}++-- | An OpenCode project.+data Project = Project+  { id :: ProjectID+  -- ^ Project ID.+  , worktree :: FilePath+  -- ^ Path to the worktree.+  , vcs :: Maybe Text+  -- ^ Version control system (e.g., @\"git\"@).+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON Project where+  parseJSON = withObject "Project" $ \v ->+    Project+      <$> v .: "id"+      <*> v .: "worktree"+      <*> v .:? "vcs"+instance ToJSON Project where+  toJSON = genericToJSON jsonOptions++-- | Server configuration.+newtype Config = Config+  { model :: Maybe ModelID+  -- ^ The configured model ID.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON Config where+  parseJSON = genericParseJSON jsonOptions+instance ToJSON Config where+  toJSON = genericToJSON jsonOptions++-- | An AI provider.+data Provider = Provider+  { id :: ProviderID+  -- ^ Provider ID (e.g., @openai@, @anthropic@).+  , name :: Text+  -- ^ Human-readable name.+  , source :: Maybe Text+  -- ^ Source type (e.g., @\"custom\"@).+  , env :: Maybe [Text]+  -- ^ Required environment variables.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON Provider where+  parseJSON = withObject "Provider" $ \v ->+    Provider+      <$> v .: "id"+      <*> v .: "name"+      <*> v .:? "source"+      <*> v .:? "env"+instance ToJSON Provider where+  toJSON = genericToJSON jsonOptions++-- | Response from listing providers.+data ProvidersResponse = ProvidersResponse+  { allProviders :: [Provider]+  -- ^ All available providers.+  , connected :: Maybe [ProviderID]+  -- ^ IDs of connected providers.+  , defaultModel :: Maybe (Map.Map ProviderID ModelID)+  -- ^ Default model per provider.+  }+  deriving stock (Show, Eq, Generic)++instance FromJSON ProvidersResponse where+  parseJSON = withObject "ProvidersResponse" $ \v ->+    ProvidersResponse+      <$> v .: "all"+      <*> v .:? "connected"+      <*> v .:? "default"+instance ToJSON ProvidersResponse where+  toJSON = genericToJSON jsonOptions