aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bbcode/src/BBCode.hs12
-rw-r--r--default.result.do18
-rw-r--r--servant/api/Thermoprint/Api.hs9
-rw-r--r--servant/servant.cabal6
-rw-r--r--servant/servant.nix4
-rw-r--r--servant/src/Main.hs105
-rw-r--r--servant/src/PrintOut.hs14
-rw-r--r--tprint/src/Main.hs222
-rw-r--r--tprint/tprint.cabal1
-rw-r--r--tprint/tprint.nix4
10 files changed, 322 insertions, 73 deletions
diff --git a/bbcode/src/BBCode.hs b/bbcode/src/BBCode.hs
index 750fb0f..3071db6 100644
--- a/bbcode/src/BBCode.hs
+++ b/bbcode/src/BBCode.hs
@@ -2,6 +2,7 @@
2 2
3module BBCode 3module BBCode
4 ( parse 4 ( parse
5 , make
5 ) where 6 ) where
6 7
7import Thermoprint 8import Thermoprint
@@ -42,6 +43,17 @@ testTag f k = fromMaybe False (f <$> Map.lookup (CI.mk k) knownTags)
42data Decorated c = Decorated c [String] 43data Decorated c = Decorated c [String]
43 deriving (Show, Eq) 44 deriving (Show, Eq)
44 45
46make :: Block String -> String
47make (Over blocks) = concat $ map make blocks
48make (Center block) = "[center]" ++ make block ++ "[/center]\n"
49make (Paragraph inline) = make' inline ++ "\n"
50
51make' :: Inline String -> String
52make' (Beside inlines) = concat $ map make' inlines
53make' (Underline inline) = "[u]" ++ make' inline ++ "[/u]"
54make' (Cooked c) = c
55make' (Raw _) = error "Cannot transform block containing raw data to bbcode"
56
45parse :: String -> Either String (Block String) 57parse :: String -> Either String (Block String)
46parse input = (remerge . blockify <$> (tokenize input >>= treeify)) >>= semantics 58parse input = (remerge . blockify <$> (tokenize input >>= treeify)) >>= semantics
47 59
diff --git a/default.result.do b/default.result.do
deleted file mode 100644
index 56be121..0000000
--- a/default.result.do
+++ /dev/null
@@ -1,18 +0,0 @@
1case $2 in
2 servant)
3 dir=servant
4 name=thermoprint-servant
5 ;;
6 *)
7 dir=$2
8 name=$2
9 ;;
10esac
11
12find $dir \( -name '*.hs' -or -name '*.cabal' -or -name '*.nix' \) -print0 | xargs --verbose --null redo-ifchange
13
14redo-ifchange default.nix
15
16nix-build -A $name -o $dir.result-link 1>&2
17
18exec readlink $dir.result-link \ No newline at end of file
diff --git a/servant/api/Thermoprint/Api.hs b/servant/api/Thermoprint/Api.hs
index bd5744b..f3318c4 100644
--- a/servant/api/Thermoprint/Api.hs
+++ b/servant/api/Thermoprint/Api.hs
@@ -14,6 +14,8 @@ import GHC.Generics
14 14
15import Control.Monad 15import Control.Monad
16 16
17import Data.Int (Int64)
18
17instance ToJSON ByteString where 19instance ToJSON ByteString where
18 toJSON = toJSON . Text.pack . ByteString.unpack 20 toJSON = toJSON . Text.pack . ByteString.unpack
19instance FromJSON ByteString where 21instance FromJSON ByteString where
@@ -25,4 +27,9 @@ instance FromJSON c => FromJSON (Inline c)
25instance ToJSON c => ToJSON (Block c) 27instance ToJSON c => ToJSON (Block c)
26instance FromJSON c => FromJSON (Block c) 28instance FromJSON c => FromJSON (Block c)
27 29
28type ThermoprintApi = "print" :> Capture "printerId" Integer :> ReqBody '[JSON] (Block String) :> Post '[JSON] () 30type ThermoprintApi = "print" :> Capture "printerId" Integer :> ReqBody '[JSON] (Block String) :> Post '[JSON] ()
31 :<|> "drafts" :> Get '[JSON] [(Int64, String)]
32 :<|> "drafts" :> ReqBody '[JSON] (String, Block String) :> Put '[JSON] Int64
33 :<|> "drafts" :> Capture "draftId" Int64 :> Get '[JSON] (String, Block String)
34 :<|> "drafts" :> Capture "draftId" Int64 :> ReqBody '[JSON] (String, Block String) :> Put '[JSON] ()
35 :<|> "drafts" :> Capture "draftId" Int64 :> Delete '[JSON] ()
diff --git a/servant/servant.cabal b/servant/servant.cabal
index b877196..dce4490 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -48,4 +48,8 @@ executable thermoprint
48 , bytestring >=0.10.6 && <0.11 48 , bytestring >=0.10.6 && <0.11
49 , either >=4.4.1 && <4.5 49 , either >=4.4.1 && <4.5
50 , optparse-applicative >=0.11.0 && <0.12 50 , optparse-applicative >=0.11.0 && <0.12
51 , transformers >=0.4.2 && <0.5 \ No newline at end of file 51 , transformers >=0.4.2 && <0.5
52 , persistent >=2.2 && <3
53 , persistent-template >=2.1 && <3
54 , persistent-sqlite >=2.2 && <3
55 , monad-logger >=0.3.13 && <1 \ No newline at end of file
diff --git a/servant/servant.nix b/servant/servant.nix
index a84fc77..5ea8d59 100644
--- a/servant/servant.nix
+++ b/servant/servant.nix
@@ -2,7 +2,8 @@
2, stdenv 2, stdenv
3, base 3, base
4, thermoprint 4, thermoprint
5, aeson, wai, servant-server, warp, optparse-applicative 5, aeson, wai, servant-server, warp, optparse-applicative, persistent
6, persistent-template, persistent-sqlite, monad-logger
6}: 7}:
7 8
8mkDerivation { 9mkDerivation {
@@ -13,6 +14,7 @@ mkDerivation {
13 isExecutable = true; 14 isExecutable = true;
14 executableHaskellDepends = [ 15 executableHaskellDepends = [
15 base thermoprint aeson wai servant-server warp optparse-applicative 16 base thermoprint aeson wai servant-server warp optparse-applicative
17 persistent persistent-template persistent-sqlite monad-logger
16 ]; 18 ];
17 homepage = "git://git.yggdrasil.li/thermoprint"; 19 homepage = "git://git.yggdrasil.li/thermoprint";
18 description = "Server for interfacing to cheap thermoprinters"; 20 description = "Server for interfacing to cheap thermoprinters";
diff --git a/servant/src/Main.hs b/servant/src/Main.hs
index 9d88559..0aa9eeb 100644
--- a/servant/src/Main.hs
+++ b/servant/src/Main.hs
@@ -1,27 +1,59 @@
1{-# LANGUAGE RecordWildCards, OverloadedStrings #-} 1{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
2{-# LANGUAGE EmptyDataDecls #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE QuasiQuotes #-}
8{-# LANGUAGE TemplateHaskell #-}
9{-# LANGUAGE TypeFamilies #-}
2 10
3import Thermoprint 11import Thermoprint
4import Thermoprint.Api 12import Thermoprint.Api
13import PrintOut
5 14
15import qualified Data.Text.Lazy as TL
16import qualified Data.ByteString.Lazy.Char8 as LBS
17import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString)
18import qualified Data.Text as T (pack)
19import Data.ByteString (ByteString)
20import qualified Data.ByteString as BS
21
6import Data.Aeson 22import Data.Aeson
7import Network.Wai 23import Network.Wai
8import Network.Wai.Handler.Warp 24import Network.Wai.Handler.Warp
9import Servant 25import Servant
10import qualified Data.Text.Lazy as Text
11import qualified Data.ByteString.Lazy.Char8 as ByteString
12import Data.ByteString.Lazy.Char8 (ByteString)
13import GHC.Generics 26import GHC.Generics
14 27
15import Control.Monad 28import Control.Monad
29import Control.Monad.Trans.Class
16import Control.Monad.IO.Class 30import Control.Monad.IO.Class
17import Control.Monad.Trans.Either 31import Control.Monad.Trans.Either
18 32
33import Control.Monad.Logger
34
19import Options.Applicative 35import Options.Applicative
20 36
21import System.IO 37import System.IO hiding (print)
38
39import Database.Persist
40import Database.Persist.Sqlite
41import Database.Persist.TH
42
43import Data.Int (Int64)
44
45import Prelude hiding (print)
46
47share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
48Draft
49 title String
50 content PrintOut
51 deriving Show
52|]
53
22 54
23server :: Options -> Integer -> Block String -> EitherT ServantErr IO () 55print :: Options -> Integer -> Block String -> EitherT ServantErr IO ()
24server Options{..} printerNo printOut = do 56print Options{..} printerNo printOut = do
25 printerPath <- case genericIndex printers printerNo of 57 printerPath <- case genericIndex printers printerNo of
26 Just path -> return path 58 Just path -> return path
27 Nothing -> left $ err404 { errBody = "printerId out of bounds" } 59 Nothing -> left $ err404 { errBody = "printerId out of bounds" }
@@ -29,7 +61,7 @@ server Options{..} printerNo printOut = do
29 where 61 where
30 doPrint handle = do 62 doPrint handle = do
31 hSetBuffering handle NoBuffering 63 hSetBuffering handle NoBuffering
32 ByteString.hPut handle $ render' printOut 64 LBS.hPut handle $ render' printOut
33 genericIndex :: Integral i => [a] -> i -> Maybe a 65 genericIndex :: Integral i => [a] -> i -> Maybe a
34 genericIndex (x:_) 0 = Just x 66 genericIndex (x:_) 0 = Just x
35 genericIndex (_:xs) n 67 genericIndex (_:xs) n
@@ -37,11 +69,47 @@ server Options{..} printerNo printOut = do
37 | otherwise = Nothing 69 | otherwise = Nothing
38 genericIndex _ _ = Nothing 70 genericIndex _ _ = Nothing
39 71
72withPool = flip runSqlPool
73
74queryDrafts :: Options -> ConnectionPool -> EitherT ServantErr IO [(Int64, String)]
75queryDrafts Options{..} cPool = withPool cPool $ do
76 drafts <- selectList [] []
77 return $ map deSQLify drafts
78 where
79 deSQLify :: Entity Draft -> (Int64, String)
80 deSQLify (Entity k (Draft title _)) = (fromSqlKey k, title)
81
82getDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO (String, Block String)
83getDraft Options{..} cPool draftId = withPool cPool $ do
84 draft <- get $ toSqlKey draftId
85 case draft of
86 Nothing -> lift $ left $ err404 { errBody = "no such draftId" }
87 Just (Draft title content) -> return (title, content)
88
89writeDraft :: Options -> ConnectionPool -> Int64 -> (String, Block String) -> EitherT ServantErr IO ()
90writeDraft Options{..} cPool draftId (draftName, draft) = withPool cPool $ repsert (toSqlKey draftId) (Draft draftName draft)
91
92addDraft :: Options -> ConnectionPool -> (String, Block String) -> EitherT ServantErr IO Int64
93addDraft Options{..} cPool (draftName, draft) = withPool cPool $ (fromSqlKey <$> insert (Draft draftName draft))
94
95delDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO ()
96delDraft Options{..} cPool draftId = withPool cPool $ delete (toSqlKey draftId :: Key Draft)
97
40data Options = Options 98data Options = Options
41 { port :: Int 99 { port :: Int
100 , connStr :: String
101 , connNmbr :: Int
42 , printers :: [FilePath] 102 , printers :: [FilePath]
43 } 103 }
44 104
105server :: Options -> ConnectionPool -> Server ThermoprintApi
106server opts cPool = print opts
107 :<|> queryDrafts opts cPool
108 :<|> addDraft opts cPool
109 :<|> getDraft opts cPool
110 :<|> writeDraft opts cPool
111 :<|> delDraft opts cPool
112
45options :: Parser Options 113options :: Parser Options
46options = Options 114options = Options
47 <$> option auto ( 115 <$> option auto (
@@ -52,6 +120,21 @@ options = Options
52 <> value 8080 120 <> value 8080
53 <> showDefault 121 <> showDefault
54 ) 122 )
123 <*> strOption (
124 long "database"
125 <> short 'd'
126 <> metavar "STRING"
127 <> help "The sqlite connection string to use (can inlude some options)"
128 <> value "./storage.sqlite"
129 <> showDefault
130 )
131 <*> option auto (
132 long "database-connections"
133 <> metavar "INT"
134 <> help "The number of parallel sqlite connections to maintain"
135 <> value 2
136 <> showDefault
137 )
55 <*> some (strArgument ( 138 <*> some (strArgument (
56 metavar "PATH [...]" 139 metavar "PATH [...]"
57 <> help "Path to one of the printers to use" 140 <> help "Path to one of the printers to use"
@@ -62,10 +145,14 @@ thermoprintApi = Proxy
62 145
63main :: IO () 146main :: IO ()
64main = do 147main = do
65 execParser opts >>= main' 148 execParser opts >>= runNoLoggingT . main'
66 where 149 where
67 opts = info (helper <*> options) ( 150 opts = info (helper <*> options) (
68 fullDesc 151 fullDesc
69 <> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter" 152 <> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter"
70 ) 153 )
71 main' args@(Options{..}) = run port $ serve thermoprintApi (server args) 154 main' args@(Options{..}) = withSqlitePool (T.pack connStr) connNmbr $ main''
155 where
156 main'' cPool = do
157 runSqlPool (runMigration migrateAll) cPool
158 liftIO $ run port $ serve thermoprintApi (server args cPool)
diff --git a/servant/src/PrintOut.hs b/servant/src/PrintOut.hs
new file mode 100644
index 0000000..5f95a22
--- /dev/null
+++ b/servant/src/PrintOut.hs
@@ -0,0 +1,14 @@
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4module PrintOut
5 ( PrintOut
6 ) where
7
8import Thermoprint
9import Thermoprint.Api
10import Database.Persist.TH
11
12type PrintOut = Block String
13
14derivePersistFieldJSON "PrintOut"
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs
index 565295b..0f88a86 100644
--- a/tprint/src/Main.hs
+++ b/tprint/src/Main.hs
@@ -1,72 +1,178 @@
1{-# LANGUAGE RecordWildCards #-} 1{-# LANGUAGE RecordWildCards, RankNTypes #-}
2 2
3import Thermoprint 3import Thermoprint
4import Thermoprint.Api 4import Thermoprint.Api
5 5
6import qualified BBCode (parse) 6import qualified BBCode (parse, make)
7 7
8import Options.Applicative 8import Options.Applicative
9 9
10import Data.Either 10import Data.Either
11import Data.Maybe
11import Control.Monad 12import Control.Monad
12import Control.Monad.Trans.Either 13import Control.Monad.Trans.Either
13 14
14import System.IO 15import System.IO
16import qualified System.IO as IO
15import System.Exit 17import System.Exit
18import System.Environment
16 19
17import Data.Proxy 20import Data.Proxy
21import Servant.API
18import Servant.Client 22import Servant.Client
19 23
24import Data.Int (Int64)
25
20thermoprintApi :: Proxy ThermoprintApi 26thermoprintApi :: Proxy ThermoprintApi
21thermoprintApi = Proxy 27thermoprintApi = Proxy
22 28
23data Options = Options 29data TPrint = TPrint TPrintMode TPrintOptions
24 { baseUrl :: BaseUrl 30
25 , printerId :: Integer 31data TPrintOptions = TPrintOptions
26 , dryRun :: Bool 32 { baseUrl :: BaseUrl
27 } 33 }
28 34
29options :: Parser Options 35data TPrintMode = Print PrintOptions
30options = Options 36 | PrintDraft PrintDraftOptions
31 <$> option baseUrlReader ( 37 | Query QueryOptions
32 long "url" 38 | Add AddOptions
33 <> short 'u' 39 | Get GetOptions
34 <> metavar "URL" 40 | Write WriteOptions
35 <> help "The base url of the api" 41 | Del DelOptions
36 <> value (BaseUrl Http "localhost" 8080) 42
37 <> showDefaultWith showBaseUrl 43data PrintOptions = PrintOptions
38 ) 44 { printerId :: Integer
39 <*> option auto ( 45 , dryRun :: Bool
40 long "printer" 46 }
41 <> short 'p' 47
42 <> metavar "INT" 48data PrintDraftOptions = PrintDraftOptions
43 <> help "The number of the printer to use" 49 { printOptions :: PrintOptions
44 <> value 0 50 , pDraftId :: Int64
45 <> showDefault 51 , deleteAfter :: Bool
46 ) 52 }
47 <*> flag False True ( 53
48 long "dry-run" 54data QueryOptions = QueryOptions
49 <> short 'd' 55
50 <> help "Instead of sending data to printer output the parsed stream to stderr" 56data AddOptions = AddOptions
51 <> showDefault 57 { title :: String
52 ) 58 }
53 where 59
54 baseUrlReader = str >>= either readerError return . parseBaseUrl 60data GetOptions = GetOptions
61 { gDraftId :: Int64
62 , getTitle :: Bool
63 }
64
65data WriteOptions = WriteOptions
66 { wDraftId :: Int64
67 , newTitle :: Maybe String
68 }
69
70data DelOptions = DelOptions
71 { dDraftId :: Int64
72 }
73
55 74
56main :: IO () 75main :: IO ()
57main = execParser opts >>= main' 76main = do
77 envUrl <- lookupEnv "TPRINT"
78 let
79 defaultUrl = fromMaybe (BaseUrl Http "localhost" 8080) (envUrl >>= either (const Nothing) Just . parseBaseUrl)
80 execParser (opts defaultUrl) >>= main'
58 where 81 where
59 opts = info (helper <*> options) ( 82 opts url = info (helper <*> opts' url) (
60 fullDesc 83 fullDesc
61 <> header "tprint - A cli tool for interfacing with the REST api as provided by thermoprint-servant" 84 <> header "tprint - A cli tool for interfacing with the REST api as provided by thermoprint-servant"
62 ) 85 )
86 opts' url = TPrint
87 <$> modeSwitch
88 <*> commonOpts url
89 commonOpts url = TPrintOptions
90 <$> option baseUrlReader (
91 long "url"
92 <> short 'u'
93 <> metavar "URL"
94 <> help "The base url of the api. Also reads TPRINT from environment."
95 <> value url
96 <> showDefaultWith showBaseUrl
97 )
98 baseUrlReader = str >>= either readerError return . parseBaseUrl
99 modeSwitch = subparser $ mconcat $ map (\(n, f, h) -> command n $ info (helper <*> f) $ progDesc h)
100 [ ("print", print, "Read bbcode from stdin and send it to be printed")
101 , ("print-draft", printD, "Send a draft to be printed")
102 , ("query", query, "List drafts")
103 , ("add", add, "Read bbcode from stdin and add it as a draft")
104 , ("get", get, "Get a draft and print it as bbcode to stdout")
105 , ("write", write, "Read bbcode from stdin and overwrite an existing draft")
106 , ("del", del, "Delete a draft")
107 ]
108 draftN s = option auto (
109 long "draft"
110 <> short 'n'
111 <> metavar "INT"
112 <> help s
113 )
114 print = Print <$> print'
115 print' = PrintOptions
116 <$> option auto (
117 long "printer"
118 <> short 'p'
119 <> metavar "INT"
120 <> help "The number of the printer to use"
121 <> value 0
122 <> showDefault
123 )
124 <*> flag False True (
125 long "dry-run"
126 <> short 'd'
127 <> help "Instead of sending data to printer output the parsed stream to stderr"
128 <> showDefault
129 )
130 printD = (PrintDraft <$>) $ PrintDraftOptions
131 <$> print'
132 <*> draftN "The number of the draft to print"
133 <*> flag False True (
134 long "delete"
135 <> help "Delete the draft after printing"
136 )
137 query = (Query <$>) $ pure QueryOptions
138 add = (Add <$>) $ AddOptions
139 <$> strArgument (
140 metavar "TITLE"
141 <> help "The human readable title for the new draft"
142 )
143 get = (Get <$>) $ GetOptions
144 <$> draftN "The number of the draft to retrieve"
145 <*> flag False True (
146 long "title"
147 <> short 't'
148 <> help "Get title instead of content"
149 )
150 write = (Write <$>) $ WriteOptions
151 <$> draftN "The number of the draft to overwrite"
152 <*> optional ( strArgument (
153 metavar "TITLE"
154 <> help "The human readable title for the updated draft (defaults to retrieving the old one before overwriting)"
155 )
156 )
157 del = (Del <$>) $ DelOptions
158 <$> draftN "The number of the draft to delete"
159
160either' :: (a -> String) -> EitherT a IO b -> IO b
161either' f a = either (die . f) return =<< runEitherT a
63 162
64 main' Options{..} = do 163main' (TPrint mode TPrintOptions{..}) = do
65 let 164 let
66 print :: Integer -> Block String -> EitherT ServantError IO () 165 -- print :: Integer -> Block String -> EitherT ServantError IO ()
67 print = client thermoprintApi baseUrl 166 -- queryDrafts :: EitherT ServantError IO [(Integer, String)]
167 -- addDraft :: (String, Block String) -> EitherT ServantError IO Int64
168 -- getDraft :: Int64 -> EitherT ServantError IO (String, Block String)
169 -- writeDraft :: Int64 -> (String, Block String) -> EitherT ServantError IO Int64
170 -- delDraft :: Int64 -> EitherT ServantError IO ()
171 (print :<|> queryDrafts :<|> addDraft :<|> getDraft :<|> writeDraft :<|> delDraft) = client thermoprintApi baseUrl
172 case mode of
173 Print PrintOptions{..} -> do
68 input <- BBCode.parse `liftM` getContents 174 input <- BBCode.parse `liftM` getContents
69 input' <- either (\err -> hPutStrLn stderr ("Parse error: " ++ err) >> exitFailure) return input 175 input' <- either (die . ("Parse error: " ++)) return input
70 case dryRun of 176 case dryRun of
71 False -> do 177 False -> do
72 res <- runEitherT $ print printerId input' 178 res <- runEitherT $ print printerId input'
@@ -75,3 +181,37 @@ main = execParser opts >>= main'
75 Right _ -> exitSuccess 181 Right _ -> exitSuccess
76 True -> do 182 True -> do
77 hPutStrLn stderr $ show input' 183 hPutStrLn stderr $ show input'
184 PrintDraft PrintDraftOptions{..} -> do
185 let PrintOptions{..} = printOptions
186 (_, input) <- either' (\e -> "Error while retrieving draft: " ++ show e) $ getDraft pDraftId
187 case dryRun of
188 False -> do
189 res <- runEitherT $ print printerId input
190 case res of
191 Left err -> hPutStrLn stderr $ show err
192 Right _ -> when deleteAfter $ either' (\e -> "Error while deleting draft: " ++ show e) $ delDraft pDraftId
193 True -> do
194 hPutStrLn stderr $ show input
195 Query QueryOptions -> do
196 drafts <- either' (\e -> "Error while retrieving drafts: " ++ show e) queryDrafts
197 mapM_ (\(n, t) -> putStrLn $ "[" ++ show n ++ "]\n" ++ (unlines $ map (\s -> " " ++ s) $ lines t)) drafts
198 when (null drafts) $ hPutStrLn stderr "No drafts"
199 Add AddOptions{..} -> do
200 input <- BBCode.parse `liftM` getContents
201 input' <- either (die . ("Parse error: " ++)) return input
202 n <- either' (\e -> "Error while saving draft: " ++ show e) $ addDraft (title, input')
203 IO.print n
204 Get GetOptions{..} -> do
205 (title, draft) <- either' (\e -> "Error while retrieving draft: " ++ show e) $ getDraft gDraftId
206 case getTitle of
207 False -> putStr $ BBCode.make draft
208 True -> putStrLn title
209 Write WriteOptions{..} -> do
210 input <- BBCode.parse `liftM` getContents
211 input' <- either (die . ("Parse error: " ++)) return input
212 title <- case newTitle of
213 Just new -> return new
214 Nothing -> fst <$> (either' (\e -> "Error while retrieving draft: " ++ show e) $ getDraft wDraftId)
215 either' (\e -> "Error while overwriting draft: " ++ show e) $ writeDraft wDraftId (title, input')
216 Del DelOptions{..} -> either' (\e -> "Error while deleting draft: " ++ show e) $ delDraft dDraftId
217 _ -> undefined
diff --git a/tprint/tprint.cabal b/tprint/tprint.cabal
index a5d2a61..54cb47d 100644
--- a/tprint/tprint.cabal
+++ b/tprint/tprint.cabal
@@ -27,5 +27,6 @@ executable tprint
27 , thermoprint-servant 27 , thermoprint-servant
28 , bbcode 28 , bbcode
29 , optparse-applicative >=0.11.0 && <1 29 , optparse-applicative >=0.11.0 && <1
30 , servant >=0.4.4 && <1
30 , servant-client >=0.4.4 && <1 31 , servant-client >=0.4.4 && <1
31 , either >=4.4.1 && <5 \ No newline at end of file 32 , either >=4.4.1 && <5 \ No newline at end of file
diff --git a/tprint/tprint.nix b/tprint/tprint.nix
index cce38c4..492a643 100644
--- a/tprint/tprint.nix
+++ b/tprint/tprint.nix
@@ -2,7 +2,7 @@
2, stdenv 2, stdenv
3, base 3, base
4, thermoprint-servant, thermoprint, bbcode 4, thermoprint-servant, thermoprint, bbcode
5, optparse-applicative, servant-client 5, optparse-applicative, servant-client, servant
6}: 6}:
7mkDerivation { 7mkDerivation {
8 pname = "tprint"; 8 pname = "tprint";
@@ -12,7 +12,7 @@ mkDerivation {
12 isExecutable = true; 12 isExecutable = true;
13 executableHaskellDepends = [ base 13 executableHaskellDepends = [ base
14 thermoprint thermoprint-servant bbcode 14 thermoprint thermoprint-servant bbcode
15 optparse-applicative servant-client 15 optparse-applicative servant-client servant
16 ]; 16 ];
17 homepage = "git://git.yggdrasil.li/thermoprint"; 17 homepage = "git://git.yggdrasil.li/thermoprint";
18 description = "A cli-tool for interfacing with thermoprint-servant"; 18 description = "A cli-tool for interfacing with thermoprint-servant";
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-26 19:01:05 +0000