diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for intelli-monad
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2024 Junji Hashimoto
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,116 @@
+# intelli-monad
+
+intelli-monad provides high level APIs for prompt engineering using openai.
+
+Featuring:
+* Type level function calling with JSON-Schema
+* Validation of return value
+* Repl interface
+* Persistent of prompt logs with SQLite
+* Session management with repl
+
+intelli-monad is based on openai-servant-gen.
+openai-servant-gen is automatically generated from OpenAPI interface.
+
+# Install
+
+```bash
+git clone git@github.com:junjihashimoto/intelli-monad.git
+cd intelli-monad
+export PATH=~/.local/bin:$PATH
+cabal install intelli-monad
+```
+
+# Usage of repl
+
+After install intelli-monad, set OPENAI_API_KEY, then run intelli-monad command.
+The system commands begin with prefix ":". Anything else will be the user's prompt.
+
+```bash
+$ export OPENAI_API_KEY=xxx
+$ export OPENAI_MODEL=xxx
+$ intelli-monad
+% :help
+:quit
+:clear
+:show contents
+:show usage
+:show request
+:show context
+:show session
+:list sessions
+:copy session <from> <to>
+:delete session <session name>
+:switch session <session name>
+:help
+% hello
+assistant: Hello! How can I assist you today?
+```
+
+# Usage of function calling with validation
+
+Here is an example of function calling and validation.
+In this example, validation is performed using the input of function calling.
+
+Define the function calling as ValidateNumber, and define the context as Math.
+
+JSONSchema type-class can output it as JSON Schema.
+Defining HasFunctionObject class adds descriptin to each field. 
+This allows Openai's interface to understand the meaning of each field.
+Tool type-class defines the input and output types of function calling, and defines the contents of the function.
+
+CustomInstruction type-class defines the context with headers and footers.
+
+runPromptWithValidation function calls LLM.
+The results will be validated and a number will be returned.
+
+
+```haskell
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Data.Aeson
+import Data.Proxy
+import GHC.Generics
+import IntelliMonad.Persist
+import IntelliMonad.Prompt
+import IntelliMonad.Types
+import OpenAI.Types
+
+data ValidateNumber = ValidateNumber
+  { number :: Double
+  }
+  deriving (Eq, Show, Generic, JSONSchema, FromJSON, ToJSON)
+
+instance HasFunctionObject ValidateNumber where
+  getFunctionName = "output_number"
+  getFunctionDescription = "validate input number"
+  getFieldDescription "number" = "A number that system outputs."
+
+instance Tool ValidateNumber where
+  data Output ValidateNumber = ValidateNumberOutput
+    { code :: Int,
+      stdout :: String,
+      stderr :: String
+    }
+    deriving (Eq, Show, Generic, FromJSON, ToJSON)
+  toolExec _ = return $ ValidateNumberOutput 0 "" ""
+
+data Math = Math
+
+instance CustomInstruction Math where
+  customHeader = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)]
+  customFooter = []
+
+main :: IO ()
+main = do
+  v <- runPromptWithValidation @ValidateNumber @StatelessConf [] [CustomInstructionProxy (Proxy @Math)] "default" (fromModel "gpt-4") "2+3+3+sin(3)"
+  print (v :: Maybe ValidateNumber)
+```
diff --git a/app/auto-talk.hs b/app/auto-talk.hs
new file mode 100644
--- /dev/null
+++ b/app/auto-talk.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Control.Monad.Trans.State (runStateT)
+import Data.Proxy
+import IntelliMonad.Persist
+import IntelliMonad.Prompt
+import IntelliMonad.Types
+
+data Haruhi = Haruhi
+
+instance CustomInstruction Haruhi where
+  customHeader = [(Content System (Message "あなたは涼宮ハルヒとして会話してください。話す時は'haruhi: 'をつけて話してください。") "" defaultUTCTime)]
+  customFooter = []
+
+data Kyon = Kyon
+
+instance CustomInstruction Kyon where
+  customHeader = [(Content System (Message "あなたは涼宮ハルヒの同級生のキョンとして会話してください。話す時は'kyon: 'をつけて話してください。") "" defaultUTCTime)]
+  customFooter = []
+
+data Env = Env
+
+instance CustomInstruction Env where
+  customHeader = [(Content System (Message "あなたは涼宮ハルヒの世界の環境として状況を設定してください。話す時は'env: 'をつけて話してください。") "" defaultUTCTime)]
+  customFooter = []
+
+toUser :: Content -> Content
+toUser c =
+  if contentUser c == Assistant
+    then c {contentUser = User}
+    else c
+
+main :: IO ()
+main = do
+  e <- initializePrompt @StatelessConf [] [CustomInstructionProxy (Proxy @Env)] "env" (fromModel "gpt-4")
+  h <- initializePrompt @StatelessConf [] [CustomInstructionProxy (Proxy @Haruhi)] "haruhi" (fromModel "gpt-4")
+  k <- initializePrompt @StatelessConf [] [CustomInstructionProxy (Proxy @Kyon)] "kyon" (fromModel "gpt-4")
+  let init' = [Content User (Message "ある駄菓子屋の前での出来ことで話を作ってください。Let's start!") "default" defaultUTCTime]
+  loop init' [] [] [] e h k
+  where
+    loop init' env haruhi kyon e h k = do
+      (env, e) <- runStateT (callWithContents @StatelessConf (map toUser (init' <> haruhi <> kyon))) e
+      print "--env--"
+      showContents env
+      (haruhi, h) <- runStateT (callWithContents @StatelessConf (map toUser (kyon <> env))) h
+      print "--haruhi--"
+      showContents haruhi
+      (kyon, k) <- runStateT (callWithContents @StatelessConf (map toUser (env <> haruhi))) k
+      print "--kyon--"
+      showContents kyon
+      loop [] env haruhi kyon e h k
diff --git a/app/calc.hs b/app/calc.hs
new file mode 100644
--- /dev/null
+++ b/app/calc.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Data.Aeson
+import Data.Proxy
+import GHC.Generics
+import IntelliMonad.Persist
+import IntelliMonad.Prompt
+import IntelliMonad.Types
+import OpenAI.Types
+
+data ValidateNumber = ValidateNumber
+  { number :: Double
+  }
+  deriving (Eq, Show, Generic, JSONSchema, FromJSON, ToJSON)
+
+instance HasFunctionObject ValidateNumber where
+  getFunctionName = "output_number"
+  getFunctionDescription = "validate input number"
+  getFieldDescription "number" = "A number that system outputs."
+
+instance Tool ValidateNumber where
+  data Output ValidateNumber = ValidateNumberOutput
+    { code :: Int,
+      stdout :: String,
+      stderr :: String
+    }
+    deriving (Eq, Show, Generic, FromJSON, ToJSON)
+  toolExec _ = return $ ValidateNumberOutput 0 "" ""
+
+data Math = Math
+
+instance CustomInstruction Math where
+  customHeader = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)]
+  customFooter = []
+
+main :: IO ()
+main = do
+  v <- runPromptWithValidation @ValidateNumber @StatelessConf [] [CustomInstructionProxy (Proxy @Math)] "default" (fromModel "gpt-4") "2+3+3+sin(3)"
+  print (v :: Maybe ValidateNumber)
diff --git a/app/repl.hs b/app/repl.hs
new file mode 100644
--- /dev/null
+++ b/app/repl.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import qualified Data.Text as T
+import Database.Persist.Sqlite (SqliteConf)
+import IntelliMonad.CustomInstructions
+import IntelliMonad.Repl
+import IntelliMonad.Tools
+import IntelliMonad.Types
+import qualified OpenAI.Types as API
+import System.Environment (lookupEnv)
+
+main :: IO ()
+main = do
+  model <- do
+    lookupEnv "OPENAI_MODEL" >>= \case
+      Just model -> return $ T.pack model
+      --      Nothing -> return "gpt-4-vision-preview"
+      Nothing -> return "gpt-4"
+  runRepl @SqliteConf
+    defaultTools
+    []
+    "default"
+    defaultRequest
+      { API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel model
+      }
+    mempty
diff --git a/intelli-monad.cabal b/intelli-monad.cabal
new file mode 100644
--- /dev/null
+++ b/intelli-monad.cabal
@@ -0,0 +1,146 @@
+cabal-version:      3.0
+name:               intelli-monad
+version:            0.1.0.0
+synopsis:           Type level prompt with openai.
+description:        Type level prompt with openai. This allows us to define function calls and value validation using types.
+license:            MIT
+
+-- The file containing the license text.
+license-file:       LICENSE
+
+-- The package author(s).
+author:             Junji Hashimoto
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer:         junji.hashimoto@gmail.com
+
+-- A copyright notice.
+-- copyright:
+category:           Development
+build-type:         Simple
+
+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
+extra-doc-files:    CHANGELOG.md
+                    README.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.
+    import:           warnings
+
+    -- Modules exported by the library.
+    exposed-modules:  IntelliMonad.Prompt
+                    , IntelliMonad.Types
+                    , IntelliMonad.Tools
+                    , IntelliMonad.Tools.Bash
+                    , IntelliMonad.Tools.TextToSpeech
+                    , IntelliMonad.Tools.DallE3
+                    , IntelliMonad.Tools.Utils
+                    , IntelliMonad.Persist
+                    , IntelliMonad.Repl
+                    , IntelliMonad.CustomInstructions
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    build-depends:    base ==4.*
+                    , JuicyPixels >= 3.3.8 && < 3.4
+                    , bytestring >= 0.11.5 && < 0.12
+                    , containers >= 0.6.7 && < 0.7
+                    , transformers >= 0.6.1 && < 0.7
+                    , vector >= 0.13.1 && < 0.14
+                    , aeson >= 2.1 && < 2.3
+                    , text >= 2.0.2 && < 2.1
+                    , time >= 1.12.2 && < 1.13
+                    , aeson-pretty >= 0.8.10 && < 0.9
+                    , process >= 1.6.17 && < 1.7
+                    , base64-bytestring >= 1.2.1 && < 1.3
+                    , haskeline >= 0.8.2 && < 0.9
+                    , http-client >= 0.7.16 && < 0.8
+                    , http-client-tls >= 0.3.6 && < 0.4
+                    , megaparsec >= 9.5 && < 9.7
+                    , openai-servant-gen >= 0.1.0 && < 0.2
+                    , servant >= 0.20.1 && < 0.21
+                    , servant-client >= 0.20 && < 0.21
+                    , persistent >= 2.14.6 && < 2.15
+                    , persistent-sqlite >= 2.13.3 && < 2.14
+                    , sixel >= 0.1.2 && < 0.2
+    -- Directories containing source files.
+    hs-source-dirs:   src
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+executable intelli-monad
+    import:           warnings
+    main-is:          repl.hs
+    build-depends:
+        base == 4.*,
+        intelli-monad,
+        openai-servant-gen,
+        text,
+        process,
+        persistent-sqlite
+    hs-source-dirs:   app
+    default-language: Haskell2010
+
+executable calc
+    import:           warnings
+    main-is:          calc.hs
+    build-depends:
+        base == 4.*,
+        intelli-monad,
+        openai-servant-gen,
+        text,
+        aeson
+    hs-source-dirs:   app
+    default-language: Haskell2010
+
+executable auto-talk
+    import:           warnings
+    main-is:          auto-talk.hs
+    build-depends:
+        base == 4.*,
+        intelli-monad,
+        openai-servant-gen,
+        text,
+        aeson,
+        transformers
+    hs-source-dirs:   app
+    default-language: Haskell2010
+    
+test-suite intelli-monad-test
+    -- Import common warning flags.
+    import:           warnings
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+    -- 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
+
+    -- Directories containing source files.
+    hs-source-dirs:   test
+
+    -- The entrypoint to the test suite.
+    main-is:          Main.hs
+
+    -- Test dependencies.
+    build-depends:
+        base ==4.*,
+        intelli-monad
diff --git a/src/IntelliMonad/CustomInstructions.hs b/src/IntelliMonad/CustomInstructions.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/CustomInstructions.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module IntelliMonad.CustomInstructions where
+
+import qualified Data.Aeson as A
+import Data.Proxy
+import GHC.Generics
+import IntelliMonad.Types
+import qualified OpenAI.Types as API
+
+defaultCustomInstructions :: [CustomInstructionProxy]
+defaultCustomInstructions = []
+
+data ValidateNumber = ValidateNumber
+  { number :: Double
+  }
+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)
+
+instance HasFunctionObject ValidateNumber where
+  getFunctionName = "output_number"
+  getFunctionDescription = "validate input number"
+  getFieldDescription "number" = "A number that system outputs."
+
+instance Tool ValidateNumber where
+  data Output ValidateNumber = ValidateNumberOutput
+    { code :: Int,
+      stdout :: String,
+      stderr :: String
+    }
+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)
+  toolExec _ = do
+    return $ ValidateNumberOutput 0 "" ""
+
+data Math = Math
+
+instance CustomInstruction Math where
+  customHeader = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)]
+  customFooter = []
+
+headers :: [CustomInstructionProxy] -> Contents
+headers [] = []
+headers (tool : tools') =
+  case tool of
+    (CustomInstructionProxy (_ :: Proxy a)) -> customHeader @a <> headers tools'
+
+footers :: [CustomInstructionProxy] -> Contents
+footers [] = []
+footers (tool : tools') =
+  case tool of
+    (CustomInstructionProxy (_ :: Proxy a)) -> customFooter @a <> footers tools'
diff --git a/src/IntelliMonad/Persist.hs b/src/IntelliMonad/Persist.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Persist.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module IntelliMonad.Persist where
+
+import Control.Monad.IO.Class
+import Data.List (maximumBy)
+import qualified Data.Set as S
+import Data.Text (Text)
+import Database.Persist
+import Database.Persist.Sqlite
+import IntelliMonad.Types
+
+data StatelessConf = StatelessConf
+
+class PersistentBackend p where
+  type Conn p
+  config :: p
+  setup :: (MonadIO m, MonadFail m) => p -> m (Maybe (Conn p))
+  initialize :: (MonadIO m, MonadFail m) => Conn p -> Context -> m ()
+  load :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m (Maybe Context)
+  loadByKey :: (MonadIO m, MonadFail m) => Conn p -> (Key Context) -> m (Maybe Context)
+  save :: (MonadIO m, MonadFail m) => Conn p -> Context -> m (Maybe (Key Context))
+  saveContents :: (MonadIO m, MonadFail m) => Conn p -> [Content] -> m ()
+  listSessions :: (MonadIO m, MonadFail m) => Conn p -> m [Text]
+  deleteSession :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m ()
+
+instance PersistentBackend SqliteConf where
+  type Conn SqliteConf = ConnectionPool
+  config =
+    SqliteConf
+      { sqlDatabase = "intelli-monad.sqlite3",
+        sqlPoolSize = 5
+      }
+  setup p = do
+    conn <- liftIO $ createPoolConfig p
+    liftIO $ runPool p (runMigration migrateAll) conn
+    return $ Just conn
+  initialize conn context = do
+    _ <- liftIO $ runPool (config @SqliteConf) (insert context) conn
+    return ()
+  load conn sessionName = do
+    (a :: [Entity Context]) <- liftIO $ runPool (config @SqliteConf) (selectList [ContextSessionName ==. sessionName] []) conn
+    if length a == 0
+      then return Nothing
+      else return $ Just $ maximumBy (\a0 a1 -> compare (contextCreated a1) (contextCreated a0)) $ map (\(Entity _ v) -> v) a
+
+  loadByKey conn key = do
+    (a :: [Entity Context]) <- liftIO $ runPool (config @SqliteConf) (selectList [ContextId ==. key] []) conn
+    if length a == 0
+      then return Nothing
+      else return $ Just $ maximumBy (\a0 a1 -> compare (contextCreated a1) (contextCreated a0)) $ map (\(Entity _ v) -> v) a
+
+  save conn context = do
+    liftIO $ runPool (config @SqliteConf) (Just <$> insert context) conn
+
+  saveContents conn contents = do
+    liftIO $ runPool (config @SqliteConf) (putMany contents) conn
+
+  listSessions conn = do
+    (a :: [Entity Context]) <- liftIO $ runPool (config @SqliteConf) (selectList [] []) conn
+    return $ S.toList $ S.fromList $ map (\(Entity _ v) -> contextSessionName v) a
+
+  deleteSession conn sessionName = do
+    liftIO $ runPool (config @SqliteConf) (deleteWhere [ContextSessionName ==. sessionName]) conn
+
+instance PersistentBackend StatelessConf where
+  type Conn StatelessConf = ()
+  config = StatelessConf
+  setup _ = return $ Just ()
+  initialize _ _ = return ()
+  load _ _ = return Nothing
+  loadByKey _ _ = return Nothing
+  save _ _ = return Nothing
+  saveContents _ _ = return ()
+  listSessions _ = return []
+  deleteSession _ _ = return ()
+
+withDB :: forall p m a. (MonadIO m, MonadFail m, PersistentBackend p) => (Conn p -> m a) -> m a
+withDB func =
+  setup (config @p) >>= \case
+    Nothing -> fail "Can not open a database."
+    Just (conn :: Conn p) -> func conn
diff --git a/src/IntelliMonad/Prompt.hs b/src/IntelliMonad/Prompt.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Prompt.hs
@@ -0,0 +1,370 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module IntelliMonad.Prompt where
+
+import Control.Monad (forM_)
+import Control.Monad.IO.Class
+import Control.Monad.Trans.State (get, put, runStateT)
+import qualified Data.Aeson as A
+import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Proxy
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import Data.Time
+import IntelliMonad.CustomInstructions
+import IntelliMonad.Persist
+import IntelliMonad.Tools
+import IntelliMonad.Types
+import Network.HTTP.Client (managerResponseTimeout, newManager, responseTimeoutMicro)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified OpenAI.API as API
+import qualified OpenAI.Types as API
+import Servant.Client (mkClientEnv, parseBaseUrl)
+import System.Environment (getEnv, lookupEnv)
+
+getContext :: (MonadIO m, MonadFail m) => Prompt m Context
+getContext = context <$> get
+
+setContext :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Context -> Prompt m ()
+setContext context = do
+  env <- get
+  put $ env {context = context}
+  _ <- withDB @p $ \conn -> save @p (conn :: Conn p) context
+  return ()
+
+switchContext :: (MonadIO m, MonadFail m) => Context -> Prompt m ()
+switchContext context = do
+  env <- get
+  put $ env {context = context}
+  return ()
+
+push :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Contents -> Prompt m ()
+push contents = do
+  prev <- getContext
+  let nextContents = prev.contextBody <> contents
+      next =
+        prev
+          { contextBody = nextContents,
+            contextRequest = toRequest prev.contextRequest (prev.contextHeader <> nextContents <> prev.contextFooter)
+          }
+  setContext @p next
+
+  withDB @p $ \conn -> saveContents @p conn contents
+  return ()
+
+pushToolReturn :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Contents -> Prompt m ()
+pushToolReturn contents = do
+  prev <- getContext
+  let toolMap = M.fromList (map (\v@(Content _ (ToolReturn id' _ _) _ _) -> (id', v)) contents)
+      nextContents =
+        concat $
+          map
+            ( \v -> case v of
+                Content _ (Message _) _ _ -> [v]
+                Content _ (Image _ _) _ _ -> [v]
+                Content _ (ToolCall id' _ _) _ _ ->
+                  case M.lookup id' toolMap of
+                    Just v' -> [v, v']
+                    Nothing -> [v]
+                Content _ (ToolReturn _ _ _) _ _ -> [v]
+            )
+            prev.contextBody
+      next =
+        prev
+          { contextBody = nextContents,
+            contextRequest = toRequest prev.contextRequest (prev.contextHeader <> nextContents <> prev.contextFooter)
+          }
+  setContext @p next
+
+  withDB @p $ \conn -> saveContents @p conn contents
+  return ()
+
+call :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Prompt m Contents
+call = loop []
+  where
+    loop ret = do
+      prev <- getContext
+      ((contents, finishReason), res) <- liftIO $ runRequest prev.contextSessionName prev.contextRequest (prev.contextHeader <> prev.contextBody <> prev.contextFooter)
+      let current_total_tokens = fromMaybe 0 $ API.completionUsageTotalUnderscoretokens <$> API.createChatCompletionResponseUsage res
+          next =
+            prev
+              { contextResponse = Just res,
+                contextTotalTokens = current_total_tokens
+              }
+      setContext @p next
+      push @p contents
+
+      let ret' = ret <> contents
+
+      case finishReason of
+        Stop -> return ret'
+        ToolCalls -> callTool next contents ret'
+        FunctionCall -> callTool next contents ret'
+        Length -> loop ret'
+        _ -> return ret'
+
+    callTool next contents ret = do
+      showContents contents
+      env <- get
+      retTool <- tryToolExec env.tools next.contextSessionName contents
+      showContents retTool
+      pushToolReturn @p retTool
+      v <- call @p
+      return $ ret <> retTool <> v
+
+callWithText :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Text -> Prompt m Contents
+callWithText input = do
+  time <- liftIO getCurrentTime
+  context <- getContext
+  let contents = [Content User (Message input) context.contextSessionName time]
+  push @p contents
+  call @p
+
+callWithContents :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Contents -> Prompt m Contents
+callWithContents input = do
+  push @p input
+  call @p
+
+callWithValidation ::
+  forall validation p m.
+  ( MonadIO m,
+    MonadFail m,
+    PersistentBackend p,
+    Tool validation,
+    A.FromJSON validation,
+    A.FromJSON (Output validation),
+    A.ToJSON validation,
+    A.ToJSON (Output validation)
+  ) => Contents -> Prompt m (Maybe validation)
+callWithValidation contents = do
+  let valid = ToolProxy (Proxy :: Proxy validation)
+  case findToolCall valid contents of
+    Just (Content _ (ToolCall _ _ args') _ _) -> do
+      let v = (A.eitherDecode (BS.fromStrict (T.encodeUtf8 args')) :: Either String validation)
+      case v of
+        Left err -> do
+          liftIO $ putStrLn err
+          return Nothing
+        Right v' -> return $ Just v'
+    _ -> return Nothing
+
+runPromptWithValidation ::
+  forall validation p m.
+  ( MonadIO m,
+    MonadFail m,
+    PersistentBackend p,
+    Tool validation,
+    A.FromJSON validation,
+    A.FromJSON (Output validation),
+    A.ToJSON validation,
+    A.ToJSON (Output validation)
+  ) =>
+  [ToolProxy] ->
+  [CustomInstructionProxy] ->
+  Text ->
+  API.CreateChatCompletionRequest ->
+  Text ->
+  m (Maybe validation)
+runPromptWithValidation tools customs sessionName req input = do
+  let valid = ToolProxy (Proxy :: Proxy validation)
+  runPrompt @p (valid : tools) customs sessionName req (callWithText @p input >>= callWithValidation @validation @p)
+
+initializePrompt :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => [ToolProxy] -> [CustomInstructionProxy] -> Text -> API.CreateChatCompletionRequest -> m PromptEnv
+initializePrompt tools customs sessionName req = do
+  let settings = addTools tools (req {API.createChatCompletionRequestTools = Nothing})
+  withDB @p $ \conn -> do
+    load @p conn sessionName >>= \case
+      Just v ->
+        return $
+          PromptEnv
+            { context = v,
+              tools = tools,
+              customInstructions = customs
+            }
+      Nothing -> do
+        time <- liftIO getCurrentTime
+        let init' =
+              PromptEnv
+                { context =
+                    Context
+                      { contextRequest = settings,
+                        contextResponse = Nothing,
+                        contextHeader = headers customs,
+                        contextBody = [],
+                        contextFooter = footers customs,
+                        contextTotalTokens = 0,
+                        contextSessionName = sessionName,
+                        contextCreated = time
+                      },
+                  tools = tools,
+                  customInstructions = customs
+                }
+        initialize @p conn (init'.context)
+        return init'
+
+runPrompt :: forall p m a. (MonadIO m, MonadFail m, PersistentBackend p) => [ToolProxy] -> [CustomInstructionProxy] -> Text -> API.CreateChatCompletionRequest -> Prompt m a -> m a
+runPrompt tools customs sessionName req func = do
+  context <- initializePrompt @p tools customs sessionName req
+  fst <$> runStateT func context
+
+instance ChatCompletion Contents where
+  toRequest orgRequest contents =
+    let messages = flip map contents $ \case
+          Content user (Message message) _ _ ->
+            API.ChatCompletionRequestMessage
+              { API.chatCompletionRequestMessageContent = Just $ API.ChatCompletionRequestMessageContentText message,
+                API.chatCompletionRequestMessageRole = userToText user,
+                API.chatCompletionRequestMessageName = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecalls = Nothing,
+                API.chatCompletionRequestMessageFunctionUnderscorecall = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecallUnderscoreid = Nothing
+              }
+          Content user (Image type' img) _ _ ->
+            API.ChatCompletionRequestMessage
+              { API.chatCompletionRequestMessageContent =
+                  Just $
+                    API.ChatCompletionRequestMessageContentParts
+                      [ API.ChatCompletionRequestMessageContentPart
+                          { API.chatCompletionRequestMessageContentPartType = "image_url",
+                            API.chatCompletionRequestMessageContentPartText = Nothing,
+                            API.chatCompletionRequestMessageContentPartImageUnderscoreurl =
+                              Just $
+                                API.ChatCompletionRequestMessageContentPartImageImageUrl
+                                  { API.chatCompletionRequestMessageContentPartImageImageUrlUrl =
+                                      "data:image/" <> type' <> ";base64," <> img,
+                                    API.chatCompletionRequestMessageContentPartImageImageUrlDetail = Nothing
+                                  }
+                          }
+                      ],
+                API.chatCompletionRequestMessageRole = userToText user,
+                API.chatCompletionRequestMessageName = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecalls = Nothing,
+                API.chatCompletionRequestMessageFunctionUnderscorecall = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecallUnderscoreid = Nothing
+              }
+          Content user (ToolCall id' name' args') _ _ ->
+            API.ChatCompletionRequestMessage
+              { API.chatCompletionRequestMessageContent = Nothing,
+                API.chatCompletionRequestMessageRole = userToText user,
+                API.chatCompletionRequestMessageName = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecalls =
+                  Just
+                    [ API.ChatCompletionMessageToolCall
+                        { API.chatCompletionMessageToolCallId = id',
+                          API.chatCompletionMessageToolCallType = "function",
+                          API.chatCompletionMessageToolCallFunction =
+                            API.ChatCompletionMessageToolCallFunction
+                              { API.chatCompletionMessageToolCallFunctionName = name',
+                                API.chatCompletionMessageToolCallFunctionArguments = args'
+                              }
+                        }
+                    ],
+                API.chatCompletionRequestMessageFunctionUnderscorecall = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecallUnderscoreid = Just id'
+              }
+          Content user (ToolReturn id' name' ret') _ _ ->
+            API.ChatCompletionRequestMessage
+              { API.chatCompletionRequestMessageContent = Just $ API.ChatCompletionRequestMessageContentText ret',
+                API.chatCompletionRequestMessageRole = userToText user,
+                API.chatCompletionRequestMessageName = Just name',
+                API.chatCompletionRequestMessageToolUnderscorecalls = Nothing,
+                API.chatCompletionRequestMessageFunctionUnderscorecall = Nothing,
+                API.chatCompletionRequestMessageToolUnderscorecallUnderscoreid = Just id'
+              }
+     in orgRequest {API.createChatCompletionRequestMessages = messages}
+  fromResponse sessionName response =
+    let res = head (API.createChatCompletionResponseChoices response)
+        message = API.createChatCompletionResponseChoicesInnerMessage res
+        role = textToUser $ API.chatCompletionResponseMessageRole message
+        content = API.chatCompletionResponseMessageContent message
+        finishReason = textToFinishReason $ API.createChatCompletionResponseChoicesInnerFinishUnderscorereason res
+        v = case API.chatCompletionResponseMessageToolUnderscorecalls message of
+          Just toolcalls -> map (\(API.ChatCompletionMessageToolCall id' _ (API.ChatCompletionMessageToolCallFunction name' args')) -> Content role (ToolCall id' name' args') sessionName defaultUTCTime) toolcalls
+          Nothing -> [Content role (Message (fromMaybe "" content)) sessionName defaultUTCTime]
+     in (v, finishReason)
+
+runRequest :: (ChatCompletion a) => Text -> API.CreateChatCompletionRequest -> a -> IO ((a, FinishReason), API.CreateChatCompletionResponse)
+runRequest sessionName defaultReq request = do
+  api_key <- (API.clientAuth . T.pack) <$> getEnv "OPENAI_API_KEY"
+  url <- do
+    lookupEnv "OPENAI_ENDPOINT" >>= \case
+      Just url -> parseBaseUrl url
+      Nothing -> parseBaseUrl "https://api.openai.com/v1/"
+  manager <-
+    newManager
+      ( tlsManagerSettings
+          { managerResponseTimeout = responseTimeoutMicro (120 * 1000 * 1000)
+          }
+      )
+  let API.OpenAIBackend {..} = API.createOpenAIClient
+      req = (toRequest defaultReq request)
+
+  lookupEnv "OPENAI_DEBUG" >>= \case
+    Just "1" -> do
+      liftIO $ do
+        BS.putStr $ BS.toStrict $ encodePretty req
+        T.putStrLn ""
+    _ -> return ()
+  res <- API.callOpenAI (mkClientEnv manager url) $ createChatCompletion api_key req
+  return (fromResponse sessionName res, res)
+
+showContents :: (MonadIO m) => Contents -> m ()
+showContents res = do
+  forM_ res $ \(Content user message _ _) ->
+    liftIO $
+      T.putStrLn $
+        userToText user
+          <> ": "
+          <> case message of
+            Message t -> t
+            Image _ _ -> "Image: ..."
+            c@(ToolCall _ _ _) -> T.pack $ show c
+            c@(ToolReturn _ _ _) -> T.pack $ show c
+
+fromModel :: Text -> API.CreateChatCompletionRequest
+fromModel model =
+  defaultRequest
+    { API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel model
+    }
+
+clear :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Prompt m ()
+clear = do
+  prev <- getContext
+  setContext @p $ prev {contextBody = []}
+
+callWithImage :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Text -> Prompt m Contents
+callWithImage imagePath = do
+  let tryReadFile = T.decodeUtf8Lenient . Base64.encode <$> BS.readFile (T.unpack imagePath)
+      imageType =
+        if T.isSuffixOf ".png" imagePath
+          then "png"
+          else
+            if T.isSuffixOf ".jpg" imagePath || T.isSuffixOf ".jpeg" imagePath
+              then "jpeg"
+              else "jpeg"
+  file <- liftIO $ tryReadFile
+  time <- liftIO getCurrentTime
+  context <- getContext
+  let contents' = [Content User (Image imageType file) context.contextSessionName time]
+  callWithContents @p contents'
diff --git a/src/IntelliMonad/Repl.hs b/src/IntelliMonad/Repl.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Repl.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module IntelliMonad.Repl where
+
+import Control.Monad (forM_)
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class (MonadTrans, lift)
+import Control.Monad.Trans.State (get, put)
+import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.ByteString as BS
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Void
+import IntelliMonad.Persist
+import IntelliMonad.Prompt
+import IntelliMonad.Types
+import qualified OpenAI.Types as API
+import System.Console.Haskeline
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import Text.Megaparsec.Char.Lexer as L
+
+type Parser = Parsec Void Text
+
+data ReplCommand
+  = Quit
+  | Clear
+  | ShowContents
+  | ShowUsage
+  | ShowRequest
+  | ShowContext
+  | ShowSession
+  | ListSessions
+  | CopySession (Text, Text)
+  | DeleteSession Text
+  | SwitchSession Text
+  | ReadImage Text
+  | UserInput Text
+  | Help
+  deriving (Eq, Show)
+
+parseRepl :: Parser ReplCommand
+parseRepl =
+  (try (lexm (string ":quit")) >> pure Quit)
+    <|> (try (lexm (string ":clear")) >> pure Clear)
+    <|> (try (lexm (string ":show") >> lexm (string "contents")) >> pure ShowContents)
+    <|> (try (lexm (string ":show") >> lexm (string "usage")) >> pure ShowUsage)
+    <|> (try (lexm (string ":show") >> lexm (string "request")) >> pure ShowRequest)
+    <|> (try (lexm (string ":show") >> lexm (string "context")) >> pure ShowContext)
+    <|> (try (lexm (string ":show") >> lexm (string "session")) >> pure ShowSession)
+    <|> (try (lexm (string ":read") >> lexm (string "image") >> lexm imagePath) >>= pure . ReadImage . T.pack)
+    <|> (try (lexm (string ":list") >> lexm (string "sessions")) >> pure ListSessions)
+    <|> (try (lexm (string ":list")) >> pure ListSessions)
+    <|> ( try
+            ( lexm (string ":copy") >> lexm (string "session") >> do
+                from <- T.pack <$> lexm sessionName
+                to <- T.pack <$> lexm sessionName
+                return (from, to)
+            )
+            >>= pure . CopySession
+        )
+    <|> (try (lexm (string ":delete") >> lexm (string "session") >> lexm sessionName) >>= pure . DeleteSession . T.pack)
+    <|> (try (lexm (string ":switch") >> lexm (string "session") >> lexm sessionName) >>= pure . SwitchSession . T.pack)
+    <|> (try (lexm (string ":help")) >> pure Help)
+  where
+    sc = L.space space1 empty empty
+    lexm = lexeme sc
+    sessionName = many alphaNumChar
+    imagePath = many (alphaNumChar <|> char '.' <|> char '/' <|> char '-')
+
+getTextInputLine :: (MonadTrans t) => t (InputT IO) (Maybe T.Text)
+getTextInputLine = fmap (fmap T.pack) (lift $ getInputLine "% ")
+
+getUserCommand :: forall p t. (PersistentBackend p, MonadTrans t) => t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
+getUserCommand = do
+  minput <- getTextInputLine
+  case minput of
+    Nothing -> return $ Right Quit
+    Just input ->
+      if T.isPrefixOf ":" input
+        then case runParser parseRepl "stdin" input of
+          Right v -> return $ Right v
+          Left err -> return $ Left err
+        else return $ Right (UserInput input)
+
+runRepl' :: forall p. (PersistentBackend p) => Prompt (InputT IO) ()
+runRepl' = do
+  getUserCommand @p >>= \case
+    Left err -> do
+      liftIO $ print err
+      runRepl' @p
+    Right Quit -> return ()
+    Right Clear -> do
+      clear @p
+      runRepl' @p
+    Right ShowContents -> do
+      context <- getContext
+      showContents context.contextBody
+      runRepl' @p
+    Right ShowUsage -> do
+      context <- getContext
+      liftIO $ do
+        print context.contextTotalTokens
+      runRepl' @p
+    Right ShowRequest -> do
+      prev <- getContext
+      let req = toRequest prev.contextRequest (prev.contextHeader <> prev.contextBody <> prev.contextFooter)
+      liftIO $ do
+        BS.putStr $ BS.toStrict $ encodePretty req
+        T.putStrLn ""
+      runRepl' @p
+    Right ShowContext -> do
+      prev <- getContext
+      liftIO $ do
+        putStrLn $ show prev
+      runRepl' @p
+    Right ShowSession -> do
+      prev <- getContext
+      liftIO $ do
+        T.putStrLn $ prev.contextSessionName
+      runRepl' @p
+    Right ListSessions -> do
+      liftIO $ do
+        list <- withDB @p $ \conn -> listSessions @p conn
+        forM_ list $ \sessionName' -> T.putStrLn sessionName'
+      runRepl' @p
+    Right (CopySession (from', to')) -> do
+      liftIO $ do
+        withDB @p $ \conn -> do
+          mv <- load @p conn from'
+          case mv of
+            Just v -> do
+              _ <- save @p conn (v {contextSessionName = to'})
+              return ()
+            Nothing -> T.putStrLn $ "Failed to load " <> from'
+      runRepl' @p
+    Right (DeleteSession session) -> do
+      withDB @p $ \conn -> deleteSession @p conn session
+      runRepl' @p
+    Right (SwitchSession session) -> do
+      mv <- withDB @p $ \conn -> load @p conn session
+      case mv of
+        Just v -> do
+          (env :: PromptEnv) <- get
+          put $ env {context = v}
+        Nothing -> liftIO $ T.putStrLn $ "Failed to load " <> session
+      runRepl' @p
+    Right (ReadImage imagePath) -> do
+      callWithImage @p imagePath >>= showContents
+      runRepl' @p
+    Right Help -> do
+      liftIO $ do
+        putStrLn ":quit"
+        putStrLn ":clear"
+        putStrLn ":show contents"
+        putStrLn ":show usage"
+        putStrLn ":show request"
+        putStrLn ":show context"
+        putStrLn ":show session"
+        putStrLn ":list sessions"
+        putStrLn ":copy session <from> <to>"
+        putStrLn ":delete session <session name>"
+        putStrLn ":switch session <session name>"
+        putStrLn ":help"
+      runRepl' @p
+    Right (UserInput input) -> do
+      callWithText @p input >>= showContents
+      runRepl' @p
+
+runRepl :: forall p. (PersistentBackend p) => [ToolProxy] -> [CustomInstructionProxy] -> Text -> API.CreateChatCompletionRequest -> Contents -> IO ()
+runRepl tools customs sessionName defaultReq contents = do
+  runInputT
+    ( Settings
+        { complete = completeFilename,
+          historyFile = Just "intelli-monad.history",
+          autoAddHistory = True
+        }
+    )
+    (runPrompt @p tools customs sessionName defaultReq (push @p contents >> runRepl' @p))
diff --git a/src/IntelliMonad/Tools.hs b/src/IntelliMonad/Tools.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Tools.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module IntelliMonad.Tools
+  ( module IntelliMonad.Tools.Utils,
+    module IntelliMonad.Tools.Bash,
+    module IntelliMonad.Tools.TextToSpeech,
+    module IntelliMonad.Tools.DallE3,
+    defaultTools,
+  )
+where
+
+import Data.Proxy
+import IntelliMonad.Tools.Bash
+import IntelliMonad.Tools.DallE3
+import IntelliMonad.Tools.TextToSpeech
+import IntelliMonad.Tools.Utils
+import IntelliMonad.Types
+
+defaultTools :: [ToolProxy]
+defaultTools =
+  [ ToolProxy (Proxy :: Proxy Bash),
+    ToolProxy (Proxy :: Proxy TextToSpeech),
+    ToolProxy (Proxy :: Proxy DallE3)
+  ]
diff --git a/src/IntelliMonad/Tools/Bash.hs b/src/IntelliMonad/Tools/Bash.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Tools/Bash.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module IntelliMonad.Tools.Bash where
+
+import qualified Data.Aeson as A
+import GHC.Generics
+import GHC.IO.Exception
+import IntelliMonad.Types
+import qualified OpenAI.Types as API
+import System.Process
+
+data Bash = Bash
+  { script :: String
+  }
+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)
+
+instance HasFunctionObject Bash where
+  getFunctionName = "call_bash_script"
+  getFunctionDescription = "Call a bash script in a local environment"
+  getFieldDescription "script" = "A script executing in a local environment"
+
+instance Tool Bash where
+  data Output Bash = BashOutput
+    { code :: Int,
+      stdout :: String,
+      stderr :: String
+    }
+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)
+
+  toolExec args = do
+    (code, stdout, stderr) <- readCreateProcessWithExitCode (shell args.script) ""
+    let code' = case code of
+          ExitSuccess -> 0
+          ExitFailure v -> v
+    return $ BashOutput code' stdout stderr
diff --git a/src/IntelliMonad/Tools/DallE3.hs b/src/IntelliMonad/Tools/DallE3.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Tools/DallE3.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module IntelliMonad.Tools.DallE3 where
+
+import Codec.Picture
+import Control.Monad.IO.Class
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Lazy as LBS
+import Data.Maybe (fromMaybe)
+import qualified Data.OSC1337 as OSC
+import qualified Data.Sixel as Sixel
+import Data.Text (Text)
+import qualified Data.Text as T
+import GHC.Generics
+import IntelliMonad.Types
+import Network.HTTP.Client (httpLbs, newManager, parseUrlThrow, responseBody)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified OpenAI.API as API
+import qualified OpenAI.Types as API
+import Servant.Client
+import System.Environment (getEnv, lookupEnv)
+
+putImage :: FilePath -> IO (Either String ())
+putImage image' = do
+  termProgram <- lookupEnv "TERM_PROGRAM"
+  imageBin <- readImage image'
+  case imageBin of
+    Left err -> return $ Left $ "Image file " ++ image' ++ " can not be read. : " ++ show err
+    Right imageBin' -> do
+      let image = convertRGB8 imageBin'
+      case termProgram of
+        Just "iTerm.app" -> do
+          OSC.putOSC image
+          putStrLn ""
+        Just "vscode" -> do
+          Sixel.putSixel image
+          putStrLn ""
+        _ -> do
+          Sixel.putSixel image
+          putStrLn ""
+      return $ Right ()
+
+data DallE3 = DallE3
+  { prompt :: T.Text,
+    size :: T.Text
+  }
+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)
+
+instance HasFunctionObject DallE3 where
+  getFunctionName = "image_generation"
+  getFunctionDescription = "Creating images from scratch based on a text prompt"
+  getFieldDescription "prompt" = "A text description of the desired image. The maximum length is 4000 characters."
+  getFieldDescription "size" = "The size of the generated images. Must be one of 1024x1024, 1792x1024, or 1024x1792 for dall-e-3 models."
+
+instance Tool DallE3 where
+  data Output DallE3 = DallE3Output
+    { code :: Int,
+      stdout :: String,
+      stderr :: String,
+      url :: Text
+    }
+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)
+  toolExec args = do
+    api_key <- (API.clientAuth . T.pack) <$> getEnv "OPENAI_API_KEY"
+    url <- parseBaseUrl "https://api.openai.com/v1/"
+    manager <- newManager tlsManagerSettings
+    let API.OpenAIBackend {..} = API.createOpenAIClient
+    let request =
+          API.CreateImageRequest
+            { createImageRequestPrompt = args.prompt,
+              createImageRequestModel = Just $ API.CreateImageRequestModel "dall-e-3",
+              createImageRequestN = Nothing,
+              createImageRequestQuality = Nothing,
+              createImageRequestResponseUnderscoreformat = Just "url",
+              createImageRequestSize = Just args.size,
+              createImageRequestStyle = Nothing,
+              createImageRequestUser = Nothing
+            }
+    res <- API.callOpenAI (mkClientEnv manager url) $ createImage api_key request
+    let url' = case res of
+          (API.ImagesResponse _ (img : _)) -> fromMaybe "" (API.imageUrl img)
+          _ -> ""
+    let downloadImage = do
+          request' <- parseUrlThrow $ T.unpack url'
+          manager' <- newManager tlsManagerSettings
+          response <- httpLbs request' manager'
+          let imageBytes = Network.HTTP.Client.responseBody response
+          LBS.writeFile "image.png" imageBytes
+    downloadImage
+    err <- do
+      liftIO $
+        putImage "image.png" >>= \case
+          Left err -> return err
+          Right _ -> return ""
+    return $ DallE3Output 0 "" err url'
diff --git a/src/IntelliMonad/Tools/TextToSpeech.hs b/src/IntelliMonad/Tools/TextToSpeech.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Tools/TextToSpeech.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module IntelliMonad.Tools.TextToSpeech where
+
+import qualified Data.Aeson as A
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+import GHC.Generics
+import GHC.IO.Exception
+import IntelliMonad.Types
+import Network.HTTP.Client (newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified OpenAI.API as API
+import qualified OpenAI.Types as API
+import Servant.Client
+import System.Environment (getEnv)
+import System.Process
+
+data TextToSpeech = TextToSpeech
+  { script :: T.Text
+  }
+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)
+
+instance HasFunctionObject TextToSpeech where
+  getFunctionName = "text_to_speech"
+  getFunctionDescription = "Speak text"
+  getFieldDescription "script" = "A script for speech"
+
+instance Tool TextToSpeech where
+  data Output TextToSpeech = TextToSpeechOutput
+    { code :: Int,
+      stdout :: String,
+      stderr :: String
+    }
+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)
+  toolExec args = do
+    api_key <- (API.clientAuth . T.pack) <$> getEnv "OPENAI_API_KEY"
+    url <- parseBaseUrl "https://api.openai.com/v1/"
+    manager <- newManager tlsManagerSettings
+    let API.OpenAIBackend {..} = API.createOpenAIClient
+    let request =
+          API.CreateSpeechRequest
+            { API.createSpeechRequestModel = API.CreateSpeechRequestModel "tts-1",
+              API.createSpeechRequestInput = args.script,
+              API.createSpeechRequestVoice = "alloy",
+              API.createSpeechRequestResponseUnderscoreformat = Just "mp3",
+              API.createSpeechRequestSpeed = Nothing
+            }
+    res <- API.callOpenAI (mkClientEnv manager url) $ createSpeech api_key request
+    BS.writeFile "out.mp3" res
+    (code, stdout, stderr) <- readCreateProcessWithExitCode (shell $ "afplay " <> "out.mp3") ""
+    let code' = case code of
+          ExitSuccess -> 0
+          ExitFailure v -> v
+    return $ TextToSpeechOutput code' stdout stderr
diff --git a/src/IntelliMonad/Tools/Utils.hs b/src/IntelliMonad/Tools/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Tools/Utils.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module IntelliMonad.Tools.Utils where
+
+import Control.Monad (forM)
+import Control.Monad.IO.Class
+import Data.Aeson (encode)
+import qualified Data.Aeson as A
+import qualified Data.ByteString as BS
+import Data.Maybe (catMaybes)
+import Data.Proxy
+import Data.Text (Text)
+import qualified Data.Text.Encoding as T
+import Data.Time
+import IntelliMonad.Types
+import qualified OpenAI.Types as API
+
+addTools :: [ToolProxy] -> API.CreateChatCompletionRequest -> API.CreateChatCompletionRequest
+addTools [] v = v
+addTools (tool : tools') v =
+  case tool of
+    (ToolProxy (_ :: Proxy a)) -> addTools tools' (toolAdd @a v)
+
+toolExec' ::
+  forall t m.
+  (MonadIO m, MonadFail m, Tool t, A.FromJSON t, A.ToJSON (Output t)) =>
+  Text ->
+  Text ->
+  Text ->
+  Text ->
+  Prompt m (Maybe Content)
+toolExec' sessionName id' name' args' = do
+  if name' == toolFunctionName @t
+    then case (A.eitherDecode (BS.fromStrict (T.encodeUtf8 args')) :: Either String t) of
+      Left _ -> return Nothing
+      Right input -> do
+        output <- liftIO $ toolExec input
+        time <- liftIO getCurrentTime
+        return $ Just $ (Content Tool (ToolReturn id' name' (T.decodeUtf8Lenient (BS.toStrict (encode output)))) sessionName time)
+    else return Nothing
+
+(<||>) ::
+  forall m.
+  (MonadIO m, MonadFail m) =>
+  (Text -> Text -> Text -> Text -> Prompt m (Maybe Content)) ->
+  (Text -> Text -> Text -> Text -> Prompt m (Maybe Content)) ->
+  Text ->
+  Text ->
+  Text ->
+  Text ->
+  Prompt m (Maybe Content)
+(<||>) tool0 tool1 sessionName id' name' args' = do
+  a <- tool0 sessionName id' name' args'
+  case a of
+    Just v -> return (Just v)
+    Nothing -> tool1 sessionName id' name' args'
+
+mergeToolCall :: (MonadIO m, MonadFail m) => [ToolProxy] -> Text -> Text -> Text -> Text -> Prompt m (Maybe Content)
+mergeToolCall [] _ _ _ _ = return Nothing
+mergeToolCall (tool : tools') sessionName id' name' args' = do
+  case tool of
+    (ToolProxy (_ :: Proxy a)) -> (toolExec' @a <||> mergeToolCall tools') sessionName id' name' args'
+
+hasToolCall :: Contents -> Bool
+hasToolCall cs =
+  let loop [] = False
+      loop ((Content _ (ToolCall _ _ _) _ _) : _) = True
+      loop (_ : cs') = loop cs'
+   in loop cs
+
+filterToolCall :: Contents -> Contents
+filterToolCall cs =
+  let loop [] = []
+      loop (m@(Content _ (ToolCall _ _ _) _ _) : cs') = m : loop cs'
+      loop (_ : cs') = loop cs'
+   in loop cs
+
+tryToolExec :: (MonadIO m, MonadFail m) => [ToolProxy] -> Text -> Contents -> Prompt m Contents
+tryToolExec tools sessionName contents = do
+  cs <- forM (filterToolCall contents) $ \(Content _ (ToolCall id' name' args') _ _) -> do
+    mergeToolCall tools sessionName id' name' args'
+  return $ catMaybes cs
+
+findToolCall :: ToolProxy -> Contents -> Maybe Content
+findToolCall _ [] = Nothing
+findToolCall t@(ToolProxy (Proxy :: Proxy a)) (c : cs) =
+  case c of
+    Content _ (Message _) _ _ -> findToolCall t cs
+    Content _ (Image _ _) _ _ -> findToolCall t cs
+    Content _ (ToolCall _ name' _) _ _ ->
+      if name' == toolFunctionName @a
+        then Just c
+        else findToolCall t cs
+    Content _ (ToolReturn _ _ _) _ _ -> findToolCall t cs
diff --git a/src/IntelliMonad/Types.hs b/src/IntelliMonad/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/IntelliMonad/Types.hs
@@ -0,0 +1,406 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IntelliMonad.Types where
+
+import qualified Codec.Picture as P
+import Control.Monad.Trans.State (StateT)
+import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Key as A
+import qualified Data.Aeson.KeyMap as A
+import Data.ByteString (ByteString, fromStrict, toStrict)
+import Data.Coerce
+import Data.Kind (Type)
+import qualified Data.Map as M
+import Data.Proxy
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time
+import qualified Data.Vector as V
+import Database.Persist
+import Database.Persist.Sqlite
+import Database.Persist.TH
+import GHC.Generics
+import qualified OpenAI.Types as API
+
+data User = User | System | Assistant | Tool deriving (Eq, Show, Ord, Generic)
+
+instance ToJSON User
+
+instance FromJSON User
+
+userToText :: User -> Text
+userToText = \case
+  User -> "user"
+  System -> "system"
+  Assistant -> "assistant"
+  Tool -> "tool"
+
+textToUser :: Text -> User
+textToUser = \case
+  "user" -> User
+  "system" -> System
+  "assistant" -> Assistant
+  "tool" -> Tool
+  v -> error $ T.unpack $ "Undefined role:" <> v
+
+instance Show (P.Image P.PixelRGB8) where
+  show _ = "Image: ..."
+
+data Message
+  = Message
+      {unText :: Text}
+  | Image
+      { imageType :: Text,
+        imageData :: Text
+      }
+  | ToolCall
+      { toolId :: Text,
+        toolName :: Text,
+        toolArguments :: Text
+      }
+  | ToolReturn
+      { toolId :: Text,
+        toolName :: Text,
+        toolContent :: Text
+      }
+  deriving (Eq, Show, Ord, Generic)
+
+data FinishReason
+  = Stop
+  | Length
+  | ToolCalls
+  | FunctionCall
+  | ContentFilter
+  | Null
+  deriving (Eq, Show)
+
+finishReasonToText :: FinishReason -> Text
+finishReasonToText = \case
+  Stop -> "stop"
+  Length -> "length"
+  ToolCalls -> "tool_calls"
+  FunctionCall -> "function_call"
+  ContentFilter -> "content_fileter"
+  Null -> "null"
+
+textToFinishReason :: Text -> FinishReason
+textToFinishReason = \case
+  "stop" -> Stop
+  "length" -> Length
+  "tool_calls" -> ToolCalls
+  "function_call" -> FunctionCall
+  "content_filter" -> ContentFilter
+  "null" -> Null
+  _ -> Null
+
+instance ToJSON Message
+
+instance FromJSON Message
+
+newtype Model = Model Text deriving (Eq, Show)
+
+class ChatCompletion a where
+  toRequest :: API.CreateChatCompletionRequest -> a -> API.CreateChatCompletionRequest
+  fromResponse :: Text -> API.CreateChatCompletionResponse -> (a, FinishReason)
+
+class (ChatCompletion a) => Validate a b where
+  tryConvert :: a -> Either a b
+
+toPV :: (ToJSON a) => a -> PersistValue
+toPV = toPersistValue . toStrict . encode
+
+fromPV :: (FromJSON a) => PersistValue -> Either Text a
+fromPV json = do
+  json' <- fmap fromStrict $ fromPersistValue json
+  case eitherDecode json' of
+    Right v -> return v
+    Left err -> Left $ "Decoding JSON fails : " <> T.pack err
+
+instance PersistField API.CreateChatCompletionRequest where
+  toPersistValue = toPV
+  fromPersistValue = fromPV
+
+instance PersistFieldSql API.CreateChatCompletionRequest where
+  sqlType _ = sqlType (Proxy @ByteString)
+
+instance PersistField API.CreateChatCompletionResponse where
+  toPersistValue = toPV
+  fromPersistValue = fromPV
+
+instance PersistFieldSql API.CreateChatCompletionResponse where
+  sqlType _ = sqlType (Proxy @ByteString)
+
+instance PersistField User where
+  toPersistValue = toPV
+  fromPersistValue = fromPV
+
+instance PersistFieldSql User where
+  sqlType _ = sqlType (Proxy @ByteString)
+
+instance PersistField Message where
+  toPersistValue = toPV
+  fromPersistValue = fromPV
+
+instance PersistFieldSql Message where
+  sqlType _ = sqlType (Proxy @ByteString)
+
+share
+  [mkPersist sqlSettings, mkMigrate "migrateAll"]
+  [persistLowerCase|
+Content
+    user User
+    message Message
+    sessionName Text
+    created UTCTime default=CURRENT_TIME
+    deriving Show
+    deriving Eq
+    deriving Ord
+Context
+    request API.CreateChatCompletionRequest
+    response API.CreateChatCompletionResponse Maybe
+    header [Content]
+    body [Content]
+    footer [Content]
+    totalTokens Int
+    sessionName Text
+    created UTCTime default=CURRENT_TIME
+    deriving Show
+    deriving Eq
+    deriving Ord
+|]
+
+data ToolProxy = forall t. (Tool t, A.FromJSON t, A.ToJSON t, A.FromJSON (Output t), A.ToJSON (Output t)) => ToolProxy (Proxy t)
+
+class CustomInstruction a where
+  customHeader :: Contents
+  customFooter :: Contents
+
+data CustomInstructionProxy = forall t. (CustomInstruction t) => CustomInstructionProxy (Proxy t)
+
+data PromptEnv = PromptEnv
+  { tools :: [ToolProxy],
+    customInstructions :: [CustomInstructionProxy],
+    context :: Context
+  }
+
+type Contents = [Content]
+
+type Prompt = StateT PromptEnv
+
+-- data TypedPrompt tools task output =
+
+type SessionName = Text
+
+defaultRequest :: API.CreateChatCompletionRequest
+defaultRequest =
+  API.CreateChatCompletionRequest
+    { API.createChatCompletionRequestMessages = [],
+      API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel "gpt-4",
+      API.createChatCompletionRequestFrequencyUnderscorepenalty = Nothing,
+      API.createChatCompletionRequestLogitUnderscorebias = Nothing,
+      API.createChatCompletionRequestLogprobs = Nothing,
+      API.createChatCompletionRequestTopUnderscorelogprobs = Nothing,
+      API.createChatCompletionRequestMaxUnderscoretokens = Nothing,
+      API.createChatCompletionRequestN = Nothing,
+      API.createChatCompletionRequestPresenceUnderscorepenalty = Nothing,
+      API.createChatCompletionRequestResponseUnderscoreformat = Nothing,
+      API.createChatCompletionRequestSeed = Just 0,
+      API.createChatCompletionRequestStop = Nothing,
+      API.createChatCompletionRequestStream = Nothing,
+      API.createChatCompletionRequestTemperature = Nothing,
+      API.createChatCompletionRequestTopUnderscorep = Nothing,
+      API.createChatCompletionRequestTools = Nothing,
+      API.createChatCompletionRequestToolUnderscorechoice = Nothing,
+      API.createChatCompletionRequestUser = Nothing,
+      API.createChatCompletionRequestFunctionUnderscorecall = Nothing,
+      API.createChatCompletionRequestFunctions = Nothing
+    }
+
+class Tool a where
+  data Output a :: Type
+
+  toolFunctionName :: Text
+  default toolFunctionName :: (HasFunctionObject a) => Text
+  toolFunctionName = T.pack $ getFunctionName @a
+
+  toolSchema :: API.ChatCompletionTool
+  default toolSchema :: (HasFunctionObject a, JSONSchema a, Generic a, GSchema a (Rep a)) => API.ChatCompletionTool
+  toolSchema = toChatCompletionTool @a
+
+  toolExec :: a -> IO (Output a)
+
+toChatCompletionTool :: forall a. (HasFunctionObject a, JSONSchema a) => API.ChatCompletionTool
+toChatCompletionTool =
+  API.ChatCompletionTool
+    { chatCompletionToolType = "function",
+      chatCompletionToolFunction =
+        API.FunctionObject
+          { functionObjectDescription = Just (T.pack $ getFunctionDescription @a),
+            functionObjectName = T.pack $ getFunctionName @a,
+            functionObjectParameters = Just $
+              case toAeson (schema @a) of
+                A.Object kv -> M.fromList $ map (\(k, v) -> (A.toString k, v)) $ A.toList kv
+                _ -> []
+          }
+    }
+
+class HasFunctionObject r where
+  getFunctionName :: String
+  getFunctionDescription :: String
+  getFieldDescription :: String -> String
+
+class JSONSchema r where
+  schema :: Schema
+  default schema :: (HasFunctionObject r, Generic r, GSchema r (Rep r)) => Schema
+  schema = gschema @r (from (undefined :: r))
+
+class GSchema s f where
+  gschema :: forall a. f a -> Schema
+
+data Schema
+  = Maybe' Schema
+  | String'
+  | Number'
+  | Integer'
+  | Object' [(String, String, Schema)]
+  | Array' Schema
+  | Boolean'
+  | Null'
+
+toAeson :: Schema -> A.Value
+toAeson = \case
+  Maybe' s -> toAeson s
+  String' -> A.Object [("type", "string")]
+  Number' -> A.Object [("type", "number")]
+  Integer' -> A.Object [("type", "integer")]
+  Object' properties ->
+    let notMaybes' :: [A.Value]
+        notMaybes' =
+          concat $
+            map
+              ( \(name, desc, schema) ->
+                  case schema of
+                    Maybe' _ -> []
+                    _ -> [A.String $ T.pack name]
+              )
+              properties
+     in A.Object
+          [ ("type", "object"),
+            ( "properties",
+              A.Object $
+                A.fromList $
+                  map
+                    ( \(name, desc, schema) ->
+                        (A.fromString name, append (toAeson schema) (A.Object [("description", A.String $ T.pack desc)]))
+                    )
+                    properties
+            ),
+            ("required", A.Array (V.fromList notMaybes'))
+          ]
+  Array' s ->
+    A.Object
+      [ ("type", "array"),
+        ("items", toAeson s)
+      ]
+  Boolean' -> A.Object [("type", "boolean")]
+  Null' -> A.Object [("type", "null")]
+
+instance Semigroup Schema where
+  (<>) (Object' a) (Object' b) = Object' (a <> b)
+  (<>) (Array' a) (Array' b) = Array' (a <> b)
+  (<>) _ _ = error "Can not concat json value."
+
+append :: A.Value -> A.Value -> A.Value
+append (A.Object a) (A.Object b) = A.Object (a <> b)
+append (A.Array a) (A.Array b) = A.Array (a <> b)
+append _ _ = error "Can not concat json value."
+
+instance {-# OVERLAPS #-} JSONSchema String where
+  schema = String'
+
+instance JSONSchema Text where
+  schema = String'
+
+instance (JSONSchema a) => JSONSchema (Maybe a) where
+  schema = Maybe' (schema @a)
+
+instance JSONSchema Integer where
+  schema = Integer'
+
+instance JSONSchema Double where
+  schema = Number'
+
+instance JSONSchema Bool where
+  schema = Boolean'
+
+instance (JSONSchema a) => JSONSchema [a] where
+  schema = Array' (schema @a)
+
+instance JSONSchema () where
+  schema = Null'
+
+instance (HasFunctionObject s, JSONSchema c) => GSchema s U1 where
+  gschema _ = Null'
+
+instance (HasFunctionObject s, JSONSchema c) => GSchema s (K1 i c) where
+  gschema _ = schema @c
+
+instance (HasFunctionObject s, GSchema s a, GSchema s b) => GSchema s (a :*: b) where
+  gschema _ = gschema @s @a undefined <> gschema @s @b undefined
+
+instance (HasFunctionObject s, GSchema s a, GSchema s b) => GSchema s (a :+: b) where
+  gschema _ = gschema @s @a undefined
+  gschema _ = gschema @s @b undefined
+
+-- | Datatype
+instance (HasFunctionObject s, GSchema s f) => GSchema s (M1 D c f) where
+  gschema _ = gschema @s @f undefined
+
+-- | Constructor Metadata
+instance (HasFunctionObject s, GSchema s f, Constructor c) => GSchema s (M1 C c f) where
+  gschema _ = gschema @s @f undefined
+
+-- | Selector Metadata
+instance (HasFunctionObject s, GSchema s f, Selector c) => GSchema s (M1 S c f) where
+  gschema a =
+    let name = selName a
+        desc = getFieldDescription @s name
+     in Object' [(name, desc, (gschema @s @f undefined))]
+
+toolAdd :: forall a. (Tool a) => API.CreateChatCompletionRequest -> API.CreateChatCompletionRequest
+toolAdd req =
+  let prevTools = case API.createChatCompletionRequestTools req of
+        Nothing -> []
+        Just v -> v
+      newTools = prevTools ++ [toolSchema @a]
+   in req {API.createChatCompletionRequestTools = Just newTools}
+
+defaultUTCTime :: UTCTime
+defaultUTCTime = UTCTime (coerce (0 :: Integer)) 0
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented."