First Types

.gitignore

@@ -22,4 +22,3 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
-

app/Main.hs

@@ -1,8 +1,53 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Main where
 
-import qualified MyLib (someFunc)
+import Agent.Server.Config (Config, configFile, loadConfigOrDefault, saveConfig)
+import Agent.Tools.Time ()
+import Agent.Tools.Tool (Tool, getToolListTH, toMarkdownDL)
+import Control.Concurrent (threadDelay)
+import Control.Exception (AsyncException (UserInterrupt), bracket, catch)
+import Control.Monad (when)
+import qualified Data.ByteString as BS
+import Data.Default
+import Data.Either (fromRight, isRight)
+import Data.Either.Extra (fromRight')
+import Data.Proxy
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Yaml (decodeFileThrow)
+import qualified Data.Yaml as YAML
+import Language.Haskell.TH
+import System.IO (hFlush, stdout)
 
 main :: IO ()
 main = do
-  putStrLn "Hello, Haskell!"
+  (conf :: Config) <- (configFile >>= maybe (return def) decodeFileThrow)
-  MyLib.someFunc
+
+  let availableTools = ($(getToolListTH) :: [Tool])
+  putStrLn "# HAgent\n"
+  putStrLn "\n## Cofig\n"
+  BS.putStr $ (YAML.encode conf) <> "\n"
+  putStrLn "## Available Tools\n"
+  mapM_ T.putStrLn $ toMarkdownDL <$> availableTools
+  bracket acquireResource releaseResource $ \_ ->
+    mainLoop `catch` handler
+  where
+    acquireResource :: IO ()
+    acquireResource = putStrLn "Acquiring resource..."
+
+    releaseResource :: () -> IO ()
+    releaseResource _ = putStrLn "Releasing resource..."
+
+    mainLoop :: IO ()
+    mainLoop = do
+      putStr "waiting for work ...\r"
+      hFlush stdout
+      -- Simulate work
+      -- Add your main loop logic here
+      threadDelay 1000000
+      mainLoop
+
+    handler :: AsyncException -> IO ()
+    handler UserInterrupt = putStrLn "\nCaught Ctrl-C. Exiting gracefully."

cabal.project

@@ -0,0 +1 @@
+packages: *.cabal

hagent.cabal

@@ -1,127 +1,96 @@
-cabal-version:      3.4
+cabal-version: 1.12
--- The cabal-version field refers to the version of the .cabal specification,
--- and can be different from the cabal-install (the tool) version and the
--- Cabal (the library) version you are using. As such, the Cabal (the library)
--- version used must be equal or greater than the version stated in this field.
--- Starting from the specification version 2.2, the cabal-version field must be
--- the first thing in the cabal file.
 
--- Initial package description 'hagent' generated by
+-- This file has been generated from package.yaml by hpack version 0.38.0.
--- 'cabal init'. For further documentation, see:
---   http://haskell.org/cabal/users-guide/
 --
--- The name of the package.
+-- see: https://github.com/sol/hpack
+
 name:               hagent
-
--- The package version.
--- See the Haskell package versioning policy (PVP) for standards
--- guiding when and how versions should be incremented.
--- https://pvp.haskell.org
--- PVP summary:     +-+------- breaking API changes
---                  | | +----- non-breaking API additions
---                  | | | +--- code changes with no API change
 version:            0.1.0.0
-
+license:            AGPL-3.0
--- A short (one-line) description of the package.
--- synopsis:
-
--- A longer description of the package.
--- description:
-
--- The license under which the package is released.
-license:            AGPL-3.0-only
-
--- The file containing the license text.
 license-file:       LICENSE
-
--- The package author(s).
 author:             Nicole Dresselhaus
-
--- An email address to which users can send suggestions, bug reports, and patches.
 maintainer:         nicole@dresselhaus.cloud
-
--- A copyright notice.
--- copyright:
 build-type:         Simple
 
--- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
-extra-doc-files:    CHANGELOG.md
-
--- Extra source files to be distributed with the package, such as examples, or a tutorial module.
--- extra-source-files:
-
-common warnings
-    ghc-options: -Wall
-
 library
-    -- Import common warning flags.
+    exposed-modules:
-    import:           warnings
+        Agent.Server.Config
-
+        Agent.Tools.Tool
-    -- Modules exported by the library.
+        Agent.Tools.Time
-    exposed-modules:  MyLib
+    other-modules:
-
+        Paths_hagent
-    -- Modules included in this library but not exported.
+    build-depends:
-    -- other-modules:
+        base >=4.20.0 && <4.21,
-
+        bytestring,
-    -- LANGUAGE extensions used by modules in this package.
+        data-default >=0.8.0 && <0.9,
-    -- other-extensions:
+        directory >=1.3.8 && <1.4,
-
+        extra ==1.8.*,
-    -- Other library packages from which modules are imported.
+        filepath >=1.5.2 && <1.6,
-    build-depends:    base ^>=4.20.0.0
+        ollama-haskell >=0.1.2 && <0.2,
-
+        template-haskell,
-    -- Directories containing source files.
+        text,
-    hs-source-dirs:   src
+        yaml >=0.11.11 && <0.12
-
+    hs-source-dirs:
-    -- Base language which the package is written in.
+        src
-    default-language: GHC2024
+    default-extensions:
+        OverloadedStrings
+        DerivingStrategies
+        DeriveAnyClass
+        DeriveGeneric
+        DerivingVia
+        GADTs
+    default-language: Haskell2010
 
 executable hagent
-    -- Import common warning flags.
-    import:           warnings
-
-    -- .hs or .lhs file containing the Main module.
     main-is: Main.hs
-
+    other-modules:
-    -- Modules included in this executable, other than Main.
+        Paths_hagent
-    -- other-modules:
-
-    -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
-
-    -- Other library packages from which modules are imported.
     build-depends:
-        base ^>=4.20.0.0,
+        base >=4.20.0 && <4.21,
-        hagent
+        bytestring,
-
+        data-default >=0.8.0 && <0.9,
-    -- Directories containing source files.
+        directory >=1.3.8 && <1.4,
-    hs-source-dirs:   app
+        extra ==1.8.*,
-
+        filepath >=1.5.2 && <1.6,
-    -- Base language which the package is written in.
+        hagent,
-    default-language: GHC2024
+        ollama-haskell >=0.1.2 && <0.2,
+        template-haskell,
+        text,
+        yaml >=0.11.11 && <0.12
+    hs-source-dirs:
+        app
+    default-extensions:
+        OverloadedStrings
+        DerivingStrategies
+        DeriveAnyClass
+        DeriveGeneric
+        DerivingVia
+        GADTs
+    default-language: Haskell2010
 
 test-suite hagent-test
-    -- Import common warning flags.
+    default-language: Haskell2010
-    import:           warnings
-
-    -- Base language which the package is written in.
-    default-language: GHC2024
-
-    -- Modules included in this executable, other than Main.
-    -- other-modules:
-
-    -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
-
-    -- The interface type and version of the test suite.
     type: exitcode-stdio-1.0
-
+    hs-source-dirs:
-    -- Directories containing source files.
+        test
-    hs-source-dirs:   test
+    default-extensions:
-
+        OverloadedStrings
-    -- The entrypoint to the test suite.
+        DerivingStrategies
+        DeriveAnyClass
+        DeriveGeneric
+        DerivingVia
+        GADTs
     main-is: Main.hs
-
+    other-modules:
-    -- Test dependencies.
+        Paths_hagent
     build-depends:
-        base ^>=4.20.0.0,
+        base >=4.20.0 && <4.21,
-        hagent
+        bytestring,
+        data-default >=0.8.0 && <0.9,
+        directory >=1.3.8 && <1.4,
+        extra ==1.8.*,
+        filepath >=1.5.2 && <1.6,
+        hagent,
+        ollama-haskell >=0.1.2 && <0.2,
+        text,
+        yaml >=0.11.11 && <0.12

package.yaml

@@ -0,0 +1,43 @@
+name: hagent
+version: '0.1.0.0'
+author: Nicole Dresselhaus
+maintainer: nicole@dresselhaus.cloud
+license: AGPL-3.0
+dependencies:
+  - base >= 4.20.0 && < 4.21
+  - data-default >= 0.8.0 && < 0.9
+  - directory >= 1.3.8 && < 1.4
+  - filepath >= 1.5.2 && < 1.6
+  - extra >= 1.8 && < 1.9
+  - ollama-haskell >= 0.1.2 && < 0.2
+  - yaml >= 0.11.11 && < 0.12
+  - text
+  - bytestring
+default-extensions:
+  - OverloadedStrings
+  - DerivingStrategies
+  - DeriveAnyClass
+  - DeriveGeneric
+  - DerivingVia
+  - GADTs
+library:
+  source-dirs: src
+  exposed-modules:
+  - Agent.Server.Config
+  - Agent.Tools.Tool
+  - Agent.Tools.Time
+  dependencies:
+  - template-haskell
+executables:
+  hagent:
+    main: Main.hs
+    source-dirs: app
+    dependencies:
+    - hagent
+    - template-haskell
+tests:
+  hagent-test:
+    main: Main.hs
+    source-dirs: test
+    dependencies:
+    - hagent

src/Agent/Server/Config.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Agent.Server.Config
+  ( configPath,
+    loadConfig,
+    loadConfigOrDefault,
+    saveConfig,
+    Config (..),
+    OllamaConfig (..),
+    NoConfigFoundException,
+    configFile,
+  )
+where
+
+import Control.Exception (Exception (..))
+import Control.Monad.Extra (whenMaybeM)
+import Data.Default (Default (..))
+import Data.Text (Text (..))
+import Data.Yaml (FromJSON, ParseException (..), ToJSON, decodeFileEither, decodeFileThrow, encodeFile)
+import GHC.Generics (Generic)
+import System.Directory (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
+import System.FilePath ((</>))
+
+data Config = Config
+  { startOllama :: Bool,
+    ollama :: OllamaConfig
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (FromJSON, ToJSON)
+
+instance Default Config where
+  def =
+    Config
+      { startOllama = False,
+        ollama = def
+      }
+
+data OllamaConfig = OllamaConfig
+  { host :: Text,
+    port :: Int,
+    cmdExtra :: Text
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (FromJSON, ToJSON)
+
+instance Default OllamaConfig where
+  def =
+    OllamaConfig
+      { host = "localhost",
+        port = 11434,
+        cmdExtra = ""
+      }
+
+data NoConfigFoundException = NotFound FilePath
+  deriving (Show)
+
+instance Exception NoConfigFoundException
+
+configPath :: FilePath
+configPath = "hAgent"
+
+configName :: FilePath
+configName = "config.yaml"
+
+configFile :: IO (Maybe FilePath)
+configFile = do
+  filepath <- (getXdgDirectory XdgConfig (configPath </> configName))
+  whenMaybeM (doesFileExist filepath) (return filepath)
+
+loadConfig :: IO (Either ParseException Config)
+loadConfig = do
+  filepath <- (getXdgDirectory XdgConfig (configPath </> configName))
+  confFile <- configFile
+  case confFile of
+    Just f -> decodeFileEither f
+    Nothing -> return $ Left $ OtherParseException $ toException $ NotFound $ filepath
+
+loadConfigOrDefault :: IO (Either ParseException Config)
+loadConfigOrDefault = do
+  confFile <- configFile
+  case confFile of
+    Just f -> decodeFileEither f
+    Nothing -> return $ Right $ def
+
+saveConfig :: Config -> IO ()
+saveConfig conf = do
+  getXdgDirectory XdgConfig configPath >>= createDirectoryIfMissing True
+  confPath <- (getXdgDirectory XdgConfig (configPath </> configName))
+  encodeFile confPath conf

src/Agent/Tools/Time.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Agent.Tools.Time where
+
+import Agent.Tools.Tool
+import Agent.Tools.Tool (Tool)
+import Control.Monad.IO.Class
+import Data.Proxy
+import Data.Text
+
+data CurrentTimeTool
+
+instance KnownTool CurrentTimeTool where
+  toolVal _ =
+    Tool
+      { name = "current_time",
+        call = "",
+        description = "Get the current Time"
+      }
+
+instance Dispatchable CurrentTimeTool () where
+  dispatch :: (MonadIO m) => Proxy t -> () -> m Text
+  dispatch Proxy () = return "Current Timed: 09.03.2025 14:38"
+  parseArgs _ _ = ()

src/Agent/Tools/Tool.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Agent.Tools.Tool where
+
+import Control.Monad.IO.Class
+import qualified Data.Kind as DK (Type)
+import Data.Proxy
+import Data.Text
+import Language.Haskell.TH
+
+data Tool = Tool
+  { name :: Text,
+    description :: Text,
+    call :: Text
+  }
+  deriving (Show)
+
+toMarkdownDL :: Tool -> Text
+toMarkdownDL t = "- " <> name t <> "(" <> call t <> ")\n: " <> description t
+
+-- | This type represents unknown type-level tools.
+data SomeTool = forall t. (KnownTool t) => SomeTool (Proxy t)
+
+-- | This class gives the tool associated with a type-level tool.
+-- There are instances of the class for every concrete tool included.
+class KnownTool (t :: DK.Type) where
+  toolVal :: Proxy t -> Tool
+
+class (KnownTool t) => Dispatchable t a where
+  dispatch :: (MonadIO m) => Proxy t -> a -> m Text
+  parseArgs :: Proxy t -> Text -> a
+
+getToolListTH :: Q Exp
+getToolListTH = do
+  ClassI _ instances <- reify ''Dispatchable
+  let toolExps =
+        [ [|toolVal (Proxy :: Proxy $(return t))|]
+        | InstanceD _ _ (AppT (AppT _ t) _) _ <-
+            instances
+        ]
+  listE toolExps

src/MyLib.hs

@@ -1,4 +0,0 @@
-module MyLib (someFunc) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"