65 lines
2.1 KiB
Haskell
65 lines
2.1 KiB
Haskell
module Main (main) where
|
|
|
|
import Relude hiding (Proxy)
|
|
|
|
import Api qualified as Api
|
|
import Cli
|
|
import Network.HTTP.Client
|
|
import Polysemy (Member, Members, Sem)
|
|
import Polysemy.Embed (Embed)
|
|
import Polysemy.Error (Error, errorToIOFinal)
|
|
import Polysemy.Output (Output)
|
|
import Polysemy.Output.IO (runOutputToStdout)
|
|
import Polysemy.Sgr (Sgr, SgrRegion, ignoreSgrFull, runSgrFull, withSgr)
|
|
import Polysemy.Final (Final, embedToFinal, runFinal)
|
|
import PrintColor
|
|
import Servant.Client
|
|
import Servant.Polysemy.Client (ServantClient, runServantClientWith)
|
|
import System.Console.ANSI
|
|
|
|
defProxy :: Proxy
|
|
defProxy = Proxy "127.0.0.1" 4444
|
|
|
|
runProgram :: ClientEnv
|
|
-> Sem [ Output Text
|
|
, ServantClient, Error ClientError
|
|
, Embed IO, Final IO
|
|
] ()
|
|
-> IO ()
|
|
runProgram clientEnv =
|
|
(>>= either (error . fromString . displayException) pure)
|
|
. runFinal
|
|
. embedToFinal
|
|
. errorToIOFinal
|
|
. runServantClientWith clientEnv
|
|
. runOutputToStdout
|
|
|
|
sgrFullInterpreter :: Member (Output Text) r
|
|
=> Bool -> Sem (SgrRegion : Sgr : r) a -> Sem r a
|
|
sgrFullInterpreter noAnsi = if noAnsi then ignoreSgrFull else runSgrFull
|
|
|
|
program :: Members [Error ClientError, ServantClient, Output Text, Sgr, SgrRegion] r
|
|
=> Choice -> Sem r ()
|
|
program GetSections = error "GetSections is not yet implemented"
|
|
program GetTopics = error "GetTopics is not yet implemented"
|
|
program GetTopic{topic_id} = showTopic topic_id
|
|
|
|
showTopic :: Members [ServantClient, Error ClientError, Output Text, Sgr, SgrRegion] r
|
|
=> Integer -> Sem r ()
|
|
showTopic topic_id = do
|
|
topic <- Api.getTopic topic_id
|
|
withSgr [SetColor Foreground Vivid White] do
|
|
printColor topic
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Options{offline, noAnsi, choice} <- getOpts
|
|
when offline do
|
|
error "Offline mode is not yet implemented"
|
|
manager' <- newManager $
|
|
defaultManagerSettings
|
|
& (managerSetProxy $ proxyEnvironmentNamed "I2P_HTTP_PROXY" $ Just defProxy)
|
|
let clientEnv = mkClientEnv manager' (BaseUrl Http "4rum.i2p" 80 "")
|
|
|
|
runProgram clientEnv . sgrFullInterpreter noAnsi $ program choice
|