diff options
-rw-r--r-- | .gitignore | 2 | ||||
-rw-r--r-- | bbcode/LICENSE | 27 | ||||
-rw-r--r-- | bbcode/Setup.hs | 2 | ||||
-rw-r--r-- | bbcode/bbcode.cabal | 33 | ||||
-rw-r--r-- | bbcode/bbcode.nix | 18 | ||||
-rw-r--r-- | bbcode/src/BBCode.hs | 120 | ||||
-rw-r--r-- | bbcode/src/BBCode/Syntax.hs | 108 | ||||
-rw-r--r-- | bbcode/src/BBCode/Tokenizer.hs | 44 | ||||
-rw-r--r-- | default.nix | 15 | ||||
-rw-r--r-- | servant/LICENSE | 27 | ||||
-rw-r--r-- | servant/Setup.hs | 2 | ||||
-rw-r--r-- | servant/api/Thermoprint/Api.hs | 35 | ||||
-rw-r--r-- | servant/servant.cabal | 55 | ||||
-rw-r--r-- | servant/servant.nix | 22 | ||||
-rw-r--r-- | servant/src/Main.hs | 158 | ||||
-rw-r--r-- | servant/src/PrintOut.hs | 14 | ||||
-rw-r--r-- | shell.nix | 14 | ||||
-rw-r--r-- | thermoprint/LICENSE | 27 | ||||
-rw-r--r-- | thermoprint/Setup.hs | 2 | ||||
-rw-r--r-- | thermoprint/src/Thermoprint.hs | 122 | ||||
-rw-r--r-- | thermoprint/thermoprint.cabal | 36 | ||||
-rw-r--r-- | thermoprint/thermoprint.nix | 19 | ||||
-rw-r--r-- | tprint/LICENSE | 27 | ||||
-rw-r--r-- | tprint/Setup.hs | 2 | ||||
-rw-r--r-- | tprint/src/Main.hs | 217 | ||||
-rw-r--r-- | tprint/tprint.cabal | 32 | ||||
-rw-r--r-- | tprint/tprint.nix | 20 |
27 files changed, 0 insertions, 1200 deletions
@@ -1,4 +1,2 @@ | |||
1 | **/\#*\# | 1 | **/\#*\# |
2 | **/result | 2 | **/result |
3 | storage.sqlite | ||
4 | test.bbcode | ||
diff --git a/bbcode/LICENSE b/bbcode/LICENSE deleted file mode 100644 index 4ad71e2..0000000 --- a/bbcode/LICENSE +++ /dev/null | |||
@@ -1,27 +0,0 @@ | |||
1 | Statement of Purpose | ||
2 | |||
3 | The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). | ||
4 | |||
5 | Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others. | ||
6 | |||
7 | For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights. | ||
8 | |||
9 | 1. Copyright and Related Rights. A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following: | ||
10 | |||
11 | the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work; | ||
12 | moral rights retained by the original author(s) and/or performer(s); | ||
13 | publicity and privacy rights pertaining to a person's image or likeness depicted in a Work; | ||
14 | rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below; | ||
15 | rights protecting the extraction, dissemination, use and reuse of data in a Work; | ||
16 | database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and | ||
17 | other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof. | ||
18 | 2. Waiver. To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose. | ||
19 | |||
20 | 3. Public License Fallback. Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose. | ||
21 | |||
22 | 4. Limitations and Disclaimers. | ||
23 | |||
24 | No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document. | ||
25 | Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law. | ||
26 | Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work. | ||
27 | Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. \ No newline at end of file | ||
diff --git a/bbcode/Setup.hs b/bbcode/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/bbcode/Setup.hs +++ /dev/null | |||
@@ -1,2 +0,0 @@ | |||
1 | import Distribution.Simple | ||
2 | main = defaultMain | ||
diff --git a/bbcode/bbcode.cabal b/bbcode/bbcode.cabal deleted file mode 100644 index b17ff34..0000000 --- a/bbcode/bbcode.cabal +++ /dev/null | |||
@@ -1,33 +0,0 @@ | |||
1 | -- Initial bbcode.cabal generated by cabal init. For further | ||
2 | -- documentation, see http://haskell.org/cabal/users-guide/ | ||
3 | |||
4 | name: bbcode | ||
5 | version: 0.0.0 | ||
6 | synopsis: A tiny parser for bbcode->thermoprint-syntax-tree conversion | ||
7 | -- description: | ||
8 | homepage: git://git.yggdrasil.li/thermoprint | ||
9 | license: PublicDomain | ||
10 | license-file: LICENSE | ||
11 | author: Gregor Kleen | ||
12 | maintainer: aethoago@141.li | ||
13 | -- copyright: | ||
14 | -- category: | ||
15 | build-type: Simple | ||
16 | -- extra-source-files: | ||
17 | cabal-version: >=1.10 | ||
18 | |||
19 | library | ||
20 | exposed-modules: BBCode | ||
21 | other-modules: BBCode.Tokenizer | ||
22 | , BBCode.Syntax | ||
23 | -- other-extensions: | ||
24 | hs-source-dirs: src | ||
25 | default-language: Haskell2010 | ||
26 | build-depends: base >=4.8 && <4.9 | ||
27 | , thermoprint | ||
28 | , attoparsec >=0.13.0 && <1 | ||
29 | , text >=1.2.1 && <2 | ||
30 | , parsec >=3.1.9 && <4 | ||
31 | , mtl >=2.2.1 && <3 | ||
32 | , case-insensitive >=1.2.0 && <2 | ||
33 | , containers >=0.5.6 && <1 \ No newline at end of file | ||
diff --git a/bbcode/bbcode.nix b/bbcode/bbcode.nix deleted file mode 100644 index d363a17..0000000 --- a/bbcode/bbcode.nix +++ /dev/null | |||
@@ -1,18 +0,0 @@ | |||
1 | { mkDerivation | ||
2 | , stdenv | ||
3 | , base | ||
4 | , thermoprint | ||
5 | , attoparsec, parsec, mtl, case-insensitive, containers | ||
6 | }: | ||
7 | mkDerivation { | ||
8 | pname = "bbcode"; | ||
9 | version = "0.0.0"; | ||
10 | src = ./.; | ||
11 | libraryHaskellDepends = [ base | ||
12 | thermoprint | ||
13 | attoparsec parsec mtl case-insensitive containers | ||
14 | ]; | ||
15 | homepage = "git://git.yggdrasil.li/thermoprint"; | ||
16 | description = "A tiny parser for bbcode->thermoprint-syntax-tree conversion"; | ||
17 | license = stdenv.lib.licenses.publicDomain; | ||
18 | } | ||
diff --git a/bbcode/src/BBCode.hs b/bbcode/src/BBCode.hs deleted file mode 100644 index 087842f..0000000 --- a/bbcode/src/BBCode.hs +++ /dev/null | |||
@@ -1,120 +0,0 @@ | |||
1 | {-# LANGUAGE OverloadedStrings, OverloadedLists, RankNTypes, ImpredicativeTypes #-} | ||
2 | |||
3 | module BBCode | ||
4 | ( parse | ||
5 | , make | ||
6 | ) where | ||
7 | |||
8 | import Thermoprint | ||
9 | |||
10 | import BBCode.Tokenizer | ||
11 | import BBCode.Syntax | ||
12 | |||
13 | import Data.Maybe | ||
14 | import Data.Monoid | ||
15 | import Data.Either | ||
16 | import Data.Bifunctor | ||
17 | import Data.List | ||
18 | import Data.Ord | ||
19 | import Data.Foldable | ||
20 | |||
21 | import Data.Function (on) | ||
22 | |||
23 | import Data.CaseInsensitive ( CI ) | ||
24 | import qualified Data.CaseInsensitive as CI | ||
25 | |||
26 | import Data.Map ( Map ) | ||
27 | import qualified Data.Map as Map | ||
28 | |||
29 | import Prelude hiding (takeWhile) | ||
30 | |||
31 | import Debug.Trace | ||
32 | |||
33 | knownTags :: Map (CI String) (Either (Block String -> Block String) (Inline String -> Inline String)) | ||
34 | knownTags = [ ("center", Left Center) | ||
35 | , ("u", Right Underline) | ||
36 | ] | ||
37 | |||
38 | isBlock, isInline :: String -> Bool | ||
39 | isBlock = testTag isLeft | ||
40 | isInline = testTag isRight | ||
41 | testTag f k = fromMaybe False (f <$> Map.lookup (CI.mk k) knownTags) | ||
42 | |||
43 | data Decorated c = Decorated c [String] | ||
44 | deriving (Show, Eq) | ||
45 | |||
46 | make :: Block String -> String | ||
47 | make (Over blocks) = concat $ map make blocks | ||
48 | make (Center block) = "[center]" ++ make block ++ "[/center]\n" | ||
49 | make (Paragraph inline) = make' inline ++ "\n" | ||
50 | |||
51 | make' :: Inline String -> String | ||
52 | make' (Beside inlines) = concat $ map make' inlines | ||
53 | make' (Underline inline) = "[u]" ++ make' inline ++ "[/u]" | ||
54 | make' (Cooked c) = c | ||
55 | make' (Raw _) = error "Cannot transform block containing raw data to bbcode" | ||
56 | |||
57 | parse :: String -> Either String (Block String) | ||
58 | parse input = massage <$> ((remerge . blockify <$> (tokenize input >>= treeify)) >>= semantics) | ||
59 | |||
60 | massage :: Block String -> Block String | ||
61 | massage (Over [x]) = massage x | ||
62 | massage (Over xs) = Over $ map massage xs | ||
63 | massage (Center x) = Center $ massage x | ||
64 | massage (Paragraph x) = Paragraph $ massage' x | ||
65 | |||
66 | massage' :: Inline String -> Inline String | ||
67 | massage' (Beside [x]) = massage' x | ||
68 | massage' (Beside xs) = Beside $ map massage' xs | ||
69 | massage' (Underline x) = Underline $ massage' x | ||
70 | massage' z = z | ||
71 | |||
72 | blockify :: ContentForest -> [Decorated String] | ||
73 | blockify = map sortDeco . concat . map (blockify' []) | ||
74 | where | ||
75 | blockify' _ Empty = [] | ||
76 | blockify' initial (Content str) = [str `Decorated` initial] | ||
77 | blockify' initial (Tagged cs tag) = concat $ map (blockify' $ tag : initial) cs | ||
78 | sortDeco :: Decorated c -> Decorated c | ||
79 | sortDeco (Decorated c tags) = Decorated c $ (nubBy ((==) `on` CI.mk) . sortBy blockiness) tags | ||
80 | blockiness :: String -> String -> Ordering | ||
81 | blockiness a b = comparing isBlock a b <> comparing CI.mk a b -- sort also alphabetically for the benefit of remerge | ||
82 | |||
83 | remerge :: [Decorated String] -> ContentForest | ||
84 | remerge [] = [] | ||
85 | remerge [(Decorated c deco)] = [appEndo applyDeco $ Content c] | ||
86 | where | ||
87 | applyDeco = foldMap (\t -> Endo (\c -> Tagged [c] t)) $ reverse deco | ||
88 | remerge xs = concat $ map toTree $ groupLasts xs | ||
89 | where | ||
90 | groupLasts = groupBy ((==) `on` (listToMaybe . reverse . (\(Decorated _ ds) -> ds))) | ||
91 | -- toTree :: [Decorated String] -> [ContentTree] | ||
92 | toTree [] = [] | ||
93 | toTree (x@(Decorated _ []):xs) = map (Content . (\(Decorated c []) -> c)) (x:xs) | ||
94 | toTree (x@(Decorated _ ds):xs) = [Tagged content tag] | ||
95 | where | ||
96 | tag = last ds | ||
97 | content = concat $ map toTree $ groupLasts $ map stripLast (x:xs) | ||
98 | stripLast (Decorated c ds) = Decorated c (init ds) | ||
99 | |||
100 | unknownTag :: forall a. String -> Either String a | ||
101 | unknownTag tag = Left $ "Unknown tag: " ++ tag | ||
102 | |||
103 | semantics :: ContentForest -> Either String (Block String) | ||
104 | semantics forest = Over <$> mapM semantics' forest | ||
105 | |||
106 | semantics' :: ContentTree -> Either String (Block String) | ||
107 | semantics' Empty = Right $ Over [] | ||
108 | semantics' (Content str) = Right $ Paragraph (Cooked str) | ||
109 | semantics' (Tagged cs tag) = case Map.lookup (CI.mk tag) knownTags of | ||
110 | Nothing -> unknownTag tag | ||
111 | Just (Left f) -> Over . map f <$> mapM semantics' cs | ||
112 | Just (Right f) -> Paragraph . Beside . map f<$> mapM iSemantics cs | ||
113 | |||
114 | iSemantics :: ContentTree -> Either String (Inline String) | ||
115 | iSemantics Empty = Right $ Beside [] | ||
116 | iSemantics (Content str) = Right $ Cooked str | ||
117 | iSemantics (Tagged cs tag) = case Map.lookup (CI.mk tag) knownTags of | ||
118 | Nothing -> unknownTag tag | ||
119 | Just (Left f) -> error "Known inline tag sorted within block" | ||
120 | Just (Right f) -> Beside . map f <$> mapM iSemantics cs | ||
diff --git a/bbcode/src/BBCode/Syntax.hs b/bbcode/src/BBCode/Syntax.hs deleted file mode 100644 index a196e05..0000000 --- a/bbcode/src/BBCode/Syntax.hs +++ /dev/null | |||
@@ -1,108 +0,0 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | |||
3 | module BBCode.Syntax | ||
4 | ( treeify | ||
5 | , ContentForest | ||
6 | , ContentTree(..) | ||
7 | ) where | ||
8 | |||
9 | import BBCode.Tokenizer (Token(..)) | ||
10 | |||
11 | import Data.Foldable | ||
12 | import Data.Bifunctor | ||
13 | import Data.Monoid | ||
14 | |||
15 | import Control.Monad.State | ||
16 | import Control.Monad.Trans | ||
17 | import Control.Monad | ||
18 | |||
19 | import Data.CaseInsensitive ( CI ) | ||
20 | import qualified Data.CaseInsensitive as CI | ||
21 | |||
22 | import Data.Function (on) | ||
23 | |||
24 | type ContentForest = [ContentTree] | ||
25 | data ContentTree = Content String | ||
26 | | Tagged [ContentTree] String | ||
27 | | Empty | ||
28 | deriving (Show, Eq) | ||
29 | |||
30 | data Step = Down [ContentTree] [ContentTree] String | ||
31 | deriving (Show) | ||
32 | |||
33 | data Zipper = Zipper | ||
34 | { hole :: String | ||
35 | , prevs :: [ContentTree] | ||
36 | , steps :: [Step] | ||
37 | } | ||
38 | deriving (Show) | ||
39 | |||
40 | type Parser = StateT Zipper (Either String) | ||
41 | abort :: String -> Parser a | ||
42 | abort = lift . Left | ||
43 | |||
44 | |||
45 | treeify :: [Token] -> Either String ContentForest | ||
46 | treeify tokenStream = second (postProcess . unZip) $ execStateT (mapM_ incorporate tokenStream) (Zipper "" [] []) | ||
47 | |||
48 | postProcess :: ContentForest -> ContentForest | ||
49 | postProcess forest = do | ||
50 | tree <- forest | ||
51 | let | ||
52 | tree' = postProcess' tree | ||
53 | guard $ tree' /= Empty | ||
54 | return tree' | ||
55 | where | ||
56 | postProcess' :: ContentTree -> ContentTree | ||
57 | postProcess' (Content "") = Empty | ||
58 | postProcess' (Tagged [] _) = Empty | ||
59 | postProcess' (Tagged cs t) = Tagged [c' | c <- cs, let c' = postProcess' c, c' /= Empty ] t | ||
60 | postProcess' x = x | ||
61 | |||
62 | unZip :: Zipper -> ContentForest | ||
63 | unZip Zipper{..} = reverse (apply hole steps : prevs) | ||
64 | |||
65 | apply :: String -> [Step] -> ContentTree | ||
66 | apply hole steps = hole `apply'` (reverse steps) | ||
67 | apply' "" [] = Empty | ||
68 | apply' hole [] = Content hole | ||
69 | apply' hole (Down pres posts tag:steps) = Tagged (reverse pres ++ [hole `apply` steps] ++ posts) tag | ||
70 | |||
71 | incorporate :: Token -> Parser () | ||
72 | incorporate (Text str) = append str | ||
73 | incorporate (Whitespace str) | ||
74 | | delimitsPar str = do | ||
75 | currSteps <- gets steps | ||
76 | if null currSteps then | ||
77 | modify (\Zipper{..} -> Zipper { hole = "", steps = [], prevs = (hole `apply` steps : prevs) }) | ||
78 | else | ||
79 | append str | ||
80 | | otherwise = append str | ||
81 | where | ||
82 | delimitsPar str = (sum . map (const (1 :: Integer)) . filter (== '\n') $ str) >= 1 | ||
83 | incorporate (TagOpen tagName) = modify $ (\z@(Zipper{..}) -> z { steps = (Down [] [] tagName : steps) }) | ||
84 | incorporate (TagClose tagName) = do | ||
85 | currSteps <- gets steps | ||
86 | case currSteps of | ||
87 | [] -> abort $ "Closing unopenend tag: " ++ tagName | ||
88 | (Down pres posts tagName':s) -> if ((==) `on` CI.mk) tagName tagName' then | ||
89 | goUp | ||
90 | else | ||
91 | abort $ "Mismatched tags: [" ++ tagName' ++ "]...[/" ++ tagName ++ "]" | ||
92 | |||
93 | append :: String -> Parser () | ||
94 | append str = modify (\z@(Zipper{..}) -> z { hole = hole ++ str }) | ||
95 | |||
96 | goUp :: Parser () | ||
97 | goUp = do | ||
98 | (Down pres posts tagName:s) <- gets steps | ||
99 | hole <- gets hole | ||
100 | let | ||
101 | steppedHole = Tagged (reverse pres ++ [Content hole] ++ posts) tagName | ||
102 | case s of | ||
103 | [] -> modify $ (\z@(Zipper{..}) -> Zipper { hole = "", prevs = steppedHole : prevs, steps = [] }) | ||
104 | (t:ts) -> do | ||
105 | let | ||
106 | (Down pres posts tagName) = t | ||
107 | t' = Down (steppedHole : pres) posts tagName | ||
108 | modify $ (\z -> z { hole = "", steps = (t':ts) }) | ||
diff --git a/bbcode/src/BBCode/Tokenizer.hs b/bbcode/src/BBCode/Tokenizer.hs deleted file mode 100644 index c860c7c..0000000 --- a/bbcode/src/BBCode/Tokenizer.hs +++ /dev/null | |||
@@ -1,44 +0,0 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | |||
3 | module BBCode.Tokenizer | ||
4 | ( Token(..) | ||
5 | , tokenize | ||
6 | ) where | ||
7 | |||
8 | import qualified Data.Text.Lazy as TL | ||
9 | import qualified Data.Text as T | ||
10 | |||
11 | import Control.Applicative | ||
12 | import Data.Attoparsec.Text.Lazy | ||
13 | |||
14 | import Data.Char (isSpace) | ||
15 | import Data.Monoid (mconcat) | ||
16 | |||
17 | data Token = Text String | ||
18 | | Whitespace String | ||
19 | | TagOpen String | ||
20 | | TagClose String | ||
21 | deriving (Show, Read, Eq) | ||
22 | |||
23 | tokenize :: String -> Either String [Token] | ||
24 | tokenize = eitherResult . parse (tokenize' <* endOfInput) . TL.pack | ||
25 | |||
26 | tokenize' :: Parser [Token] | ||
27 | tokenize' = many $ choice [ whitespace | ||
28 | , Text . T.unpack <$> ("\\" *> "[") | ||
29 | , tagClose | ||
30 | , tagOpen | ||
31 | , text | ||
32 | ] | ||
33 | |||
34 | whitespace :: Parser Token | ||
35 | whitespace = Whitespace <$> many1 space | ||
36 | |||
37 | tagOpen :: Parser Token | ||
38 | tagOpen = TagOpen . T.unpack <$> ("[" *> takeWhile1 (/= ']') <* "]") | ||
39 | |||
40 | tagClose :: Parser Token | ||
41 | tagClose = TagClose . T.unpack <$> ("[/" *> takeWhile1 (/= ']') <* "]") | ||
42 | |||
43 | text :: Parser Token | ||
44 | text = Text . T.unpack <$> takeWhile1 (\c -> not (isSpace c) && notInClass "[" c) | ||
diff --git a/default.nix b/default.nix deleted file mode 100644 index 8c1478b..0000000 --- a/default.nix +++ /dev/null | |||
@@ -1,15 +0,0 @@ | |||
1 | { pkgs ? (import <nixpkgs> {}) | ||
2 | }: | ||
3 | |||
4 | rec { | ||
5 | tprint = pkgs.haskellPackages.callPackage ./tprint/tprint.nix { | ||
6 | inherit thermoprint-servant thermoprint bbcode; | ||
7 | }; | ||
8 | bbcode = pkgs.haskellPackages.callPackage ./bbcode/bbcode.nix { | ||
9 | inherit thermoprint; | ||
10 | }; | ||
11 | thermoprint-servant = pkgs.haskellPackages.callPackage ./servant/servant.nix { | ||
12 | inherit thermoprint; | ||
13 | }; | ||
14 | thermoprint = pkgs.haskellPackages.callPackage ./thermoprint/thermoprint.nix {}; | ||
15 | } | ||
diff --git a/servant/LICENSE b/servant/LICENSE deleted file mode 100644 index 4ad71e2..0000000 --- a/servant/LICENSE +++ /dev/null | |||
@@ -1,27 +0,0 @@ | |||
1 | Statement of Purpose | ||
2 | |||
3 | The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). | ||
4 | |||
5 | Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others. | ||
6 | |||
7 | For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights. | ||
8 | |||
9 | 1. Copyright and Related Rights. A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following: | ||
10 | |||
11 | the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work; | ||
12 | moral rights retained by the original author(s) and/or performer(s); | ||
13 | publicity and privacy rights pertaining to a person's image or likeness depicted in a Work; | ||
14 | rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below; | ||
15 | rights protecting the extraction, dissemination, use and reuse of data in a Work; | ||
16 | database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and | ||
17 | other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof. | ||
18 | 2. Waiver. To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose. | ||
19 | |||
20 | 3. Public License Fallback. Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose. | ||
21 | |||
22 | 4. Limitations and Disclaimers. | ||
23 | |||
24 | No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document. | ||
25 | Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law. | ||
26 | Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work. | ||
27 | Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. \ No newline at end of file | ||
diff --git a/servant/Setup.hs b/servant/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/servant/Setup.hs +++ /dev/null | |||
@@ -1,2 +0,0 @@ | |||
1 | import Distribution.Simple | ||
2 | main = defaultMain | ||
diff --git a/servant/api/Thermoprint/Api.hs b/servant/api/Thermoprint/Api.hs deleted file mode 100644 index f3318c4..0000000 --- a/servant/api/Thermoprint/Api.hs +++ /dev/null | |||
@@ -1,35 +0,0 @@ | |||
1 | {-# LANGUAGE DataKinds, TypeOperators, DeriveGeneric #-} | ||
2 | |||
3 | module Thermoprint.Api | ||
4 | ( ThermoprintApi | ||
5 | ) where | ||
6 | |||
7 | import Thermoprint | ||
8 | import Data.Aeson | ||
9 | import Servant.API | ||
10 | import qualified Data.Text.Lazy as Text | ||
11 | import qualified Data.ByteString.Lazy.Char8 as ByteString | ||
12 | import Data.ByteString.Lazy.Char8 (ByteString) | ||
13 | import GHC.Generics | ||
14 | |||
15 | import Control.Monad | ||
16 | |||
17 | import Data.Int (Int64) | ||
18 | |||
19 | instance ToJSON ByteString where | ||
20 | toJSON = toJSON . Text.pack . ByteString.unpack | ||
21 | instance FromJSON ByteString where | ||
22 | parseJSON value = (ByteString.pack . Text.unpack) `liftM` parseJSON value | ||
23 | |||
24 | instance ToJSON c => ToJSON (Inline c) | ||
25 | instance FromJSON c => FromJSON (Inline c) | ||
26 | |||
27 | instance ToJSON c => ToJSON (Block c) | ||
28 | instance FromJSON c => FromJSON (Block c) | ||
29 | |||
30 | type 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 deleted file mode 100644 index dce4490..0000000 --- a/servant/servant.cabal +++ /dev/null | |||
@@ -1,55 +0,0 @@ | |||
1 | -- Initial thermoprint.cabal generated by cabal init. For further | ||
2 | -- documentation, see http://haskell.org/cabal/users-guide/ | ||
3 | |||
4 | name: thermoprint-servant | ||
5 | version: 0.0.0 | ||
6 | synopsis: Server for interfacing to cheap thermoprinters | ||
7 | -- description: | ||
8 | homepage: git://git.yggdrasil.li/thermoprint | ||
9 | license: PublicDomain | ||
10 | license-file: LICENSE | ||
11 | author: Gregor Kleen | ||
12 | maintainer: aethoago@141.li | ||
13 | -- copyright: | ||
14 | category: Web | ||
15 | build-type: Simple | ||
16 | -- extra-source-files: | ||
17 | cabal-version: >=1.10 | ||
18 | |||
19 | library | ||
20 | exposed-modules: Thermoprint.Api | ||
21 | hs-source-dirs: api | ||
22 | default-language: Haskell2010 | ||
23 | other-extensions: DataKinds | ||
24 | , TypeOperators | ||
25 | , DeriveGeneric | ||
26 | build-depends: base >=4.8 && <4.9 | ||
27 | , thermoprint | ||
28 | , aeson >=0.9.0 && <0.10 | ||
29 | , servant >=0.4.4 && <0.5 | ||
30 | , text >=1.2.1 && <4.5 | ||
31 | , bytestring >=0.10.6 && <0.11 | ||
32 | |||
33 | executable thermoprint | ||
34 | main-is: Main.hs | ||
35 | hs-source-dirs: src | ||
36 | default-language: Haskell2010 | ||
37 | -- other-modules: | ||
38 | other-extensions: RecordWildCards | ||
39 | , OverloadedStrings | ||
40 | build-depends: base >=4.8 && <4.9 | ||
41 | , thermoprint | ||
42 | , thermoprint-servant | ||
43 | , aeson >=0.9.0 && <0.10 | ||
44 | , wai >=3.0.3 && <3.1 | ||
45 | , servant-server >=0.4.4 && <0.5 | ||
46 | , warp >=3.1.3 && <3.2 | ||
47 | , text >=1.2.1 && <1.3 | ||
48 | , bytestring >=0.10.6 && <0.11 | ||
49 | , either >=4.4.1 && <4.5 | ||
50 | , optparse-applicative >=0.11.0 && <0.12 | ||
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 deleted file mode 100644 index 5ea8d59..0000000 --- a/servant/servant.nix +++ /dev/null | |||
@@ -1,22 +0,0 @@ | |||
1 | { mkDerivation | ||
2 | , stdenv | ||
3 | , base | ||
4 | , thermoprint | ||
5 | , aeson, wai, servant-server, warp, optparse-applicative, persistent | ||
6 | , persistent-template, persistent-sqlite, monad-logger | ||
7 | }: | ||
8 | |||
9 | mkDerivation { | ||
10 | pname = "thermoprint-servant"; | ||
11 | version = "0.0.0"; | ||
12 | src = ./.; | ||
13 | isLibrary = true; | ||
14 | isExecutable = true; | ||
15 | executableHaskellDepends = [ | ||
16 | base thermoprint aeson wai servant-server warp optparse-applicative | ||
17 | persistent persistent-template persistent-sqlite monad-logger | ||
18 | ]; | ||
19 | homepage = "git://git.yggdrasil.li/thermoprint"; | ||
20 | description = "Server for interfacing to cheap thermoprinters"; | ||
21 | license = stdenv.lib.licenses.publicDomain; | ||
22 | } | ||
diff --git a/servant/src/Main.hs b/servant/src/Main.hs deleted file mode 100644 index 0aa9eeb..0000000 --- a/servant/src/Main.hs +++ /dev/null | |||
@@ -1,158 +0,0 @@ | |||
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 #-} | ||
10 | |||
11 | import Thermoprint | ||
12 | import Thermoprint.Api | ||
13 | import PrintOut | ||
14 | |||
15 | import qualified Data.Text.Lazy as TL | ||
16 | import qualified Data.ByteString.Lazy.Char8 as LBS | ||
17 | import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString) | ||
18 | import qualified Data.Text as T (pack) | ||
19 | import Data.ByteString (ByteString) | ||
20 | import qualified Data.ByteString as BS | ||
21 | |||
22 | import Data.Aeson | ||
23 | import Network.Wai | ||
24 | import Network.Wai.Handler.Warp | ||
25 | import Servant | ||
26 | import GHC.Generics | ||
27 | |||
28 | import Control.Monad | ||
29 | import Control.Monad.Trans.Class | ||
30 | import Control.Monad.IO.Class | ||
31 | import Control.Monad.Trans.Either | ||
32 | |||
33 | import Control.Monad.Logger | ||
34 | |||
35 | import Options.Applicative | ||
36 | |||
37 | import System.IO hiding (print) | ||
38 | |||
39 | import Database.Persist | ||
40 | import Database.Persist.Sqlite | ||
41 | import Database.Persist.TH | ||
42 | |||
43 | import Data.Int (Int64) | ||
44 | |||
45 | import Prelude hiding (print) | ||
46 | |||
47 | share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| | ||
48 | Draft | ||
49 | title String | ||
50 | content PrintOut | ||
51 | deriving Show | ||
52 | |] | ||
53 | |||
54 | |||
55 | print :: Options -> Integer -> Block String -> EitherT ServantErr IO () | ||
56 | print Options{..} printerNo printOut = do | ||
57 | printerPath <- case genericIndex printers printerNo of | ||
58 | Just path -> return path | ||
59 | Nothing -> left $ err404 { errBody = "printerId out of bounds" } | ||
60 | liftIO $ withFile printerPath WriteMode doPrint | ||
61 | where | ||
62 | doPrint handle = do | ||
63 | hSetBuffering handle NoBuffering | ||
64 | LBS.hPut handle $ render' printOut | ||
65 | genericIndex :: Integral i => [a] -> i -> Maybe a | ||
66 | genericIndex (x:_) 0 = Just x | ||
67 | genericIndex (_:xs) n | ||
68 | | n > 0 = genericIndex xs (n - 1) | ||
69 | | otherwise = Nothing | ||
70 | genericIndex _ _ = Nothing | ||
71 | |||
72 | withPool = flip runSqlPool | ||
73 | |||
74 | queryDrafts :: Options -> ConnectionPool -> EitherT ServantErr IO [(Int64, String)] | ||
75 | queryDrafts 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 | |||
82 | getDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO (String, Block String) | ||
83 | getDraft 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 | |||
89 | writeDraft :: Options -> ConnectionPool -> Int64 -> (String, Block String) -> EitherT ServantErr IO () | ||
90 | writeDraft Options{..} cPool draftId (draftName, draft) = withPool cPool $ repsert (toSqlKey draftId) (Draft draftName draft) | ||
91 | |||
92 | addDraft :: Options -> ConnectionPool -> (String, Block String) -> EitherT ServantErr IO Int64 | ||
93 | addDraft Options{..} cPool (draftName, draft) = withPool cPool $ (fromSqlKey <$> insert (Draft draftName draft)) | ||
94 | |||
95 | delDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO () | ||
96 | delDraft Options{..} cPool draftId = withPool cPool $ delete (toSqlKey draftId :: Key Draft) | ||
97 | |||
98 | data Options = Options | ||
99 | { port :: Int | ||
100 | , connStr :: String | ||
101 | , connNmbr :: Int | ||
102 | , printers :: [FilePath] | ||
103 | } | ||
104 | |||
105 | server :: Options -> ConnectionPool -> Server ThermoprintApi | ||
106 | server 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 | |||
113 | options :: Parser Options | ||
114 | options = Options | ||
115 | <$> option auto ( | ||
116 | long "port" | ||
117 | <> short 'p' | ||
118 | <> metavar "PORT" | ||
119 | <> help "The port we'll run the server on" | ||
120 | <> value 8080 | ||
121 | <> showDefault | ||
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 | ) | ||
138 | <*> some (strArgument ( | ||
139 | metavar "PATH [...]" | ||
140 | <> help "Path to one of the printers to use" | ||
141 | )) | ||
142 | |||
143 | thermoprintApi :: Proxy ThermoprintApi | ||
144 | thermoprintApi = Proxy | ||
145 | |||
146 | main :: IO () | ||
147 | main = do | ||
148 | execParser opts >>= runNoLoggingT . main' | ||
149 | where | ||
150 | opts = info (helper <*> options) ( | ||
151 | fullDesc | ||
152 | <> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter" | ||
153 | ) | ||
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 deleted file mode 100644 index 5f95a22..0000000 --- a/servant/src/PrintOut.hs +++ /dev/null | |||
@@ -1,14 +0,0 @@ | |||
1 | {-# LANGUAGE TemplateHaskell #-} | ||
2 | {-# LANGUAGE TypeSynonymInstances #-} | ||
3 | {-# LANGUAGE FlexibleInstances #-} | ||
4 | module PrintOut | ||
5 | ( PrintOut | ||
6 | ) where | ||
7 | |||
8 | import Thermoprint | ||
9 | import Thermoprint.Api | ||
10 | import Database.Persist.TH | ||
11 | |||
12 | type PrintOut = Block String | ||
13 | |||
14 | derivePersistFieldJSON "PrintOut" | ||
diff --git a/shell.nix b/shell.nix deleted file mode 100644 index df3ed18..0000000 --- a/shell.nix +++ /dev/null | |||
@@ -1,14 +0,0 @@ | |||
1 | { pkgs ? (import <nixpkgs> {}) | ||
2 | , compiler ? "ghc7102" | ||
3 | }: | ||
4 | |||
5 | let | ||
6 | ghc = pkgs.haskell.packages.${compiler}.ghcWithPackages (ps: with ps; [ | ||
7 | cabal-install hlint cabal2nix | ||
8 | ] ++ (builtins.attrValues (import ./default.nix {}))); | ||
9 | in | ||
10 | pkgs.stdenv.mkDerivation { | ||
11 | name = "thermoprinter-env"; | ||
12 | buildInputs = [ ghc ]; | ||
13 | shellHook = "eval $(egrep ^export ${ghc}/bin/ghc)"; | ||
14 | } | ||
diff --git a/thermoprint/LICENSE b/thermoprint/LICENSE deleted file mode 100644 index 4ad71e2..0000000 --- a/thermoprint/LICENSE +++ /dev/null | |||
@@ -1,27 +0,0 @@ | |||
1 | Statement of Purpose | ||
2 | |||
3 | The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). | ||
4 | |||
5 | Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others. | ||
6 | |||
7 | For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights. | ||
8 | |||
9 | 1. Copyright and Related Rights. A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following: | ||
10 | |||
11 | the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work; | ||
12 | moral rights retained by the original author(s) and/or performer(s); | ||
13 | publicity and privacy rights pertaining to a person's image or likeness depicted in a Work; | ||
14 | rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below; | ||
15 | rights protecting the extraction, dissemination, use and reuse of data in a Work; | ||
16 | database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and | ||
17 | other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof. | ||
18 | 2. Waiver. To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose. | ||
19 | |||
20 | 3. Public License Fallback. Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose. | ||
21 | |||
22 | 4. Limitations and Disclaimers. | ||
23 | |||
24 | No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document. | ||
25 | Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law. | ||
26 | Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work. | ||
27 | Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. \ No newline at end of file | ||
diff --git a/thermoprint/Setup.hs b/thermoprint/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/thermoprint/Setup.hs +++ /dev/null | |||
@@ -1,2 +0,0 @@ | |||
1 | import Distribution.Simple | ||
2 | main = defaultMain | ||
diff --git a/thermoprint/src/Thermoprint.hs b/thermoprint/src/Thermoprint.hs deleted file mode 100644 index 399d0a4..0000000 --- a/thermoprint/src/Thermoprint.hs +++ /dev/null | |||
@@ -1,122 +0,0 @@ | |||
1 | {-# LANGUAGE DeriveFunctor, DeriveGeneric, RecordWildCards, FlexibleInstances #-} | ||
2 | module Thermoprint | ||
3 | ( Block(..) | ||
4 | , Inline(..) | ||
5 | , PrinterConf(..) | ||
6 | , render | ||
7 | , render' | ||
8 | , module Data.Monoid | ||
9 | ) where | ||
10 | |||
11 | import Data.Default | ||
12 | import qualified Data.ByteString.Lazy as Lazy (ByteString) | ||
13 | import Data.ByteString.Lazy.Char8 (pack) | ||
14 | import Data.Monoid | ||
15 | import GHC.Generics | ||
16 | |||
17 | import Data.Binary.Put | ||
18 | import Data.Encoding | ||
19 | import Data.Encoding.CP437 | ||
20 | import Data.Word | ||
21 | |||
22 | import Data.List | ||
23 | |||
24 | -- data PrintOut c = Paragraph c | ||
25 | -- | Center (PrintOut c) | ||
26 | -- | Underline (PrintOut c) | ||
27 | -- | Concat (PrintOut c) (PrintOut c) | ||
28 | -- | Raw Lazy.ByteString | ||
29 | -- deriving (Show, Read, Eq, Functor, Generic) | ||
30 | |||
31 | data Block c = Over [Block c] | ||
32 | | Center (Block c) | ||
33 | | Paragraph (Inline c) | ||
34 | deriving (Show, Read, Eq, Functor, Generic) | ||
35 | data Inline c = Beside [Inline c] | ||
36 | | Underline (Inline c) | ||
37 | | Cooked c | ||
38 | | Raw Lazy.ByteString | ||
39 | deriving (Show, Read, Eq, Functor, Generic) | ||
40 | |||
41 | instance Monoid (Block c) where | ||
42 | mempty = Over [] | ||
43 | mappend (Over xs) (Over ys) = Over (xs ++ ys) | ||
44 | mappend x (Over xs) = Over (x:xs) | ||
45 | mappend (Over xs) x = Over (xs ++ [x]) | ||
46 | mappend x y = Over [x,y] | ||
47 | |||
48 | instance Monoid c => Monoid (Inline c) where | ||
49 | mempty = Beside [] | ||
50 | mappend (Cooked a) (Cooked b) = Cooked (a <> b) | ||
51 | mappend (Beside xs) (Beside ys) = Beside (xs ++ ys) | ||
52 | mappend x (Beside xs) = Beside (x:xs) | ||
53 | mappend (Beside xs) x = Beside (xs ++ [x]) | ||
54 | mappend x y = Beside [x,y] | ||
55 | |||
56 | data PrinterConf c = PrinterConf | ||
57 | { renderCenter :: Put -> Put | ||
58 | , renderUnderline :: Put -> Put | ||
59 | , renderBeside :: [Put] -> Put | ||
60 | , renderOver :: [Put] -> Put | ||
61 | , renderParagraph :: Put -> Put | ||
62 | , renderCooked :: c -> Put | ||
63 | , finalize :: Put -> Put | ||
64 | , columns :: Integer | ||
65 | } | ||
66 | |||
67 | instance Default (PrinterConf String) where | ||
68 | def = PrinterConf | ||
69 | { renderCenter = bracket [97, 1] [97, 0] -- . (>> enc "\n") | ||
70 | , renderUnderline = bracket [45, 2] [45, 0] | ||
71 | , renderBeside = sequence_ | ||
72 | , renderOver = sequence_ | ||
73 | , renderParagraph = (>> enc "\n") | ||
74 | , renderCooked = enc -- . wordBreak columns | ||
75 | , finalize = \t -> escSequence [64] >> t >> enc "\n" | ||
76 | , columns = columns | ||
77 | } | ||
78 | where | ||
79 | columns = 32 :: Integer | ||
80 | esc = 27 :: Word8 | ||
81 | enc :: String -> Put | ||
82 | enc = encode CP437 | ||
83 | escSequence :: [Word8] -> Put | ||
84 | escSequence = mapM_ putWord8 . (esc:) | ||
85 | bracket :: [Word8] -> [Word8] -> Put -> Put | ||
86 | bracket start end t = escSequence start >> t >> escSequence end | ||
87 | sequence_ :: Monad m => [m a] -> m () | ||
88 | sequence_ xs = sequence xs >> return () | ||
89 | ensureNewl :: String -> String | ||
90 | ensureNewl [] = "\n" | ||
91 | ensureNewl str | ||
92 | | last str == '\n' = str | ||
93 | | otherwise = str ++ "\n" | ||
94 | wordBreak :: Integer -> String -> String | ||
95 | wordBreak _ [] = [] | ||
96 | wordBreak remains str | ||
97 | | w' > remains = (concat . intersperse "\n" $ chunk columns w) ++ wordBreak (w'' `div` columns) rest | ||
98 | | remains - w' == 0 = w ++ "\n" ++ wordBreak columns rest | ||
99 | | otherwise = w ++ wordBreak (remains - w') rest | ||
100 | where | ||
101 | (w:ws) = words str | ||
102 | rest = unwords ws | ||
103 | w' = genericLength w | ||
104 | w'' = w' - remains | ||
105 | chunk :: Integer -> [a] -> [[a]] | ||
106 | chunk _ [] = [] | ||
107 | |||
108 | render :: PrinterConf c -> Block c -> Lazy.ByteString | ||
109 | render PrinterConf{..} = runPut . finalize . deconstruct | ||
110 | where | ||
111 | -- deconstruct :: Block c -> Put | ||
112 | deconstruct (Over xs) = renderOver $ map deconstruct xs | ||
113 | deconstruct (Center x) = renderCenter $ deconstruct x | ||
114 | deconstruct (Paragraph x) = renderParagraph $ deconstruct' x | ||
115 | -- deconstruct' :: Inline c -> Put | ||
116 | deconstruct' (Beside xs) = renderBeside $ map deconstruct' xs | ||
117 | deconstruct' (Underline x) = renderUnderline $ deconstruct' x | ||
118 | deconstruct' (Cooked x) = renderCooked x | ||
119 | deconstruct' (Raw x) = putLazyByteString x | ||
120 | |||
121 | render' :: Block String -> Lazy.ByteString | ||
122 | render' = render def | ||
diff --git a/thermoprint/thermoprint.cabal b/thermoprint/thermoprint.cabal deleted file mode 100644 index ffd59dd..0000000 --- a/thermoprint/thermoprint.cabal +++ /dev/null | |||
@@ -1,36 +0,0 @@ | |||
1 | name: thermoprint | ||
2 | version: 0.0.0 | ||
3 | synopsis: Description of formatting supported by cheap thermoprinters | ||
4 | -- description: | ||
5 | homepage: git://git.yggdrasil.li/thermoprint | ||
6 | license: PublicDomain | ||
7 | license-file: LICENSE | ||
8 | author: Gregor Kleen | ||
9 | maintainer: aethoago@141.li | ||
10 | -- copyright: | ||
11 | -- category: | ||
12 | |||
13 | build-type: Simple | ||
14 | |||
15 | -- extra-source-files: | ||
16 | cabal-version: >=1.10 | ||
17 | |||
18 | |||
19 | library | ||
20 | exposed-modules: Thermoprint | ||
21 | -- other-modules: | ||
22 | hs-source-dirs: src | ||
23 | |||
24 | default-language: Haskell2010 | ||
25 | other-extensions: DeriveFunctor | ||
26 | , DeriveGeneric | ||
27 | , RecordWildCards | ||
28 | , FlexibleInstances | ||
29 | |||
30 | build-depends: base >=4.8 && <4.9 | ||
31 | , bytestring >=0.10.6 && <0.11 | ||
32 | , binary >=0.7.5 && <0.8 | ||
33 | , encoding >=0.8 && <0.9 | ||
34 | , data-default >=0.5.3 && <0.6 | ||
35 | |||
36 | \ No newline at end of file | ||
diff --git a/thermoprint/thermoprint.nix b/thermoprint/thermoprint.nix deleted file mode 100644 index 76b8875..0000000 --- a/thermoprint/thermoprint.nix +++ /dev/null | |||
@@ -1,19 +0,0 @@ | |||
1 | { mkDerivation | ||
2 | , stdenv | ||
3 | , base | ||
4 | , encoding, data-default | ||
5 | }: | ||
6 | |||
7 | mkDerivation { | ||
8 | pname = "thermoprint"; | ||
9 | version = "0.0.0"; | ||
10 | src = ./.; | ||
11 | isLibrary = true; | ||
12 | isExecutable = false; | ||
13 | libraryHaskellDepends = [ | ||
14 | base encoding data-default | ||
15 | ]; | ||
16 | homepage = "git://git.yggdrasil.li/thermoprint"; | ||
17 | description = "Description of formatting supported by cheap thermoprinters"; | ||
18 | license = stdenv.lib.licenses.publicDomain; | ||
19 | } | ||
diff --git a/tprint/LICENSE b/tprint/LICENSE deleted file mode 100644 index 4ad71e2..0000000 --- a/tprint/LICENSE +++ /dev/null | |||
@@ -1,27 +0,0 @@ | |||
1 | Statement of Purpose | ||
2 | |||
3 | The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). | ||
4 | |||
5 | Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others. | ||
6 | |||
7 | For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights. | ||
8 | |||
9 | 1. Copyright and Related Rights. A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following: | ||
10 | |||
11 | the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work; | ||
12 | moral rights retained by the original author(s) and/or performer(s); | ||
13 | publicity and privacy rights pertaining to a person's image or likeness depicted in a Work; | ||
14 | rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below; | ||
15 | rights protecting the extraction, dissemination, use and reuse of data in a Work; | ||
16 | database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and | ||
17 | other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof. | ||
18 | 2. Waiver. To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose. | ||
19 | |||
20 | 3. Public License Fallback. Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose. | ||
21 | |||
22 | 4. Limitations and Disclaimers. | ||
23 | |||
24 | No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document. | ||
25 | Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law. | ||
26 | Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work. | ||
27 | Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. \ No newline at end of file | ||
diff --git a/tprint/Setup.hs b/tprint/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/tprint/Setup.hs +++ /dev/null | |||
@@ -1,2 +0,0 @@ | |||
1 | import Distribution.Simple | ||
2 | main = defaultMain | ||
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs deleted file mode 100644 index 0f88a86..0000000 --- a/tprint/src/Main.hs +++ /dev/null | |||
@@ -1,217 +0,0 @@ | |||
1 | {-# LANGUAGE RecordWildCards, RankNTypes #-} | ||
2 | |||
3 | import Thermoprint | ||
4 | import Thermoprint.Api | ||
5 | |||
6 | import qualified BBCode (parse, make) | ||
7 | |||
8 | import Options.Applicative | ||
9 | |||
10 | import Data.Either | ||
11 | import Data.Maybe | ||
12 | import Control.Monad | ||
13 | import Control.Monad.Trans.Either | ||
14 | |||
15 | import System.IO | ||
16 | import qualified System.IO as IO | ||
17 | import System.Exit | ||
18 | import System.Environment | ||
19 | |||
20 | import Data.Proxy | ||
21 | import Servant.API | ||
22 | import Servant.Client | ||
23 | |||
24 | import Data.Int (Int64) | ||
25 | |||
26 | thermoprintApi :: Proxy ThermoprintApi | ||
27 | thermoprintApi = Proxy | ||
28 | |||
29 | data TPrint = TPrint TPrintMode TPrintOptions | ||
30 | |||
31 | data TPrintOptions = TPrintOptions | ||
32 | { baseUrl :: BaseUrl | ||
33 | } | ||
34 | |||
35 | data TPrintMode = Print PrintOptions | ||
36 | | PrintDraft PrintDraftOptions | ||
37 | | Query QueryOptions | ||
38 | | Add AddOptions | ||
39 | | Get GetOptions | ||
40 | | Write WriteOptions | ||
41 | | Del DelOptions | ||
42 | |||
43 | data PrintOptions = PrintOptions | ||
44 | { printerId :: Integer | ||
45 | , dryRun :: Bool | ||
46 | } | ||
47 | |||
48 | data PrintDraftOptions = PrintDraftOptions | ||
49 | { printOptions :: PrintOptions | ||
50 | , pDraftId :: Int64 | ||
51 | , deleteAfter :: Bool | ||
52 | } | ||
53 | |||
54 | data QueryOptions = QueryOptions | ||
55 | |||
56 | data AddOptions = AddOptions | ||
57 | { title :: String | ||
58 | } | ||
59 | |||
60 | data GetOptions = GetOptions | ||
61 | { gDraftId :: Int64 | ||
62 | , getTitle :: Bool | ||
63 | } | ||
64 | |||
65 | data WriteOptions = WriteOptions | ||
66 | { wDraftId :: Int64 | ||
67 | , newTitle :: Maybe String | ||
68 | } | ||
69 | |||
70 | data DelOptions = DelOptions | ||
71 | { dDraftId :: Int64 | ||
72 | } | ||
73 | |||
74 | |||
75 | main :: IO () | ||
76 | main = 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' | ||
81 | where | ||
82 | opts url = info (helper <*> opts' url) ( | ||
83 | fullDesc | ||
84 | <> header "tprint - A cli tool for interfacing with the REST api as provided by thermoprint-servant" | ||
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 | |||
160 | either' :: (a -> String) -> EitherT a IO b -> IO b | ||
161 | either' f a = either (die . f) return =<< runEitherT a | ||
162 | |||
163 | main' (TPrint mode TPrintOptions{..}) = do | ||
164 | let | ||
165 | -- print :: Integer -> Block String -> EitherT ServantError IO () | ||
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 | ||
174 | input <- BBCode.parse `liftM` getContents | ||
175 | input' <- either (die . ("Parse error: " ++)) return input | ||
176 | case dryRun of | ||
177 | False -> do | ||
178 | res <- runEitherT $ print printerId input' | ||
179 | case res of | ||
180 | Left err -> hPutStrLn stderr $ show err | ||
181 | Right _ -> exitSuccess | ||
182 | True -> do | ||
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 deleted file mode 100644 index 54cb47d..0000000 --- a/tprint/tprint.cabal +++ /dev/null | |||
@@ -1,32 +0,0 @@ | |||
1 | -- Initial tprint.cabal generated by cabal init. For further | ||
2 | -- documentation, see http://haskell.org/cabal/users-guide/ | ||
3 | |||
4 | name: tprint | ||
5 | version: 0.0.0 | ||
6 | synopsis: A cli-tool for interfacing with thermoprint-servant | ||
7 | -- description: | ||
8 | homepage: git://git.yggdrasil.li/thermoprint | ||
9 | license: PublicDomain | ||
10 | license-file: LICENSE | ||
11 | author: Gregor Kleen | ||
12 | maintainer: aethoago@141.li | ||
13 | -- copyright: | ||
14 | -- category: | ||
15 | build-type: Simple | ||
16 | -- extra-source-files: | ||
17 | cabal-version: >=1.10 | ||
18 | |||
19 | executable tprint | ||
20 | main-is: Main.hs | ||
21 | -- other-modules: | ||
22 | -- other-extensions: | ||
23 | hs-source-dirs: src | ||
24 | default-language: Haskell2010 | ||
25 | build-depends: base >=4.8 && <4.9 | ||
26 | , thermoprint | ||
27 | , thermoprint-servant | ||
28 | , bbcode | ||
29 | , optparse-applicative >=0.11.0 && <1 | ||
30 | , servant >=0.4.4 && <1 | ||
31 | , servant-client >=0.4.4 && <1 | ||
32 | , either >=4.4.1 && <5 \ No newline at end of file | ||
diff --git a/tprint/tprint.nix b/tprint/tprint.nix deleted file mode 100644 index 492a643..0000000 --- a/tprint/tprint.nix +++ /dev/null | |||
@@ -1,20 +0,0 @@ | |||
1 | { mkDerivation | ||
2 | , stdenv | ||
3 | , base | ||
4 | , thermoprint-servant, thermoprint, bbcode | ||
5 | , optparse-applicative, servant-client, servant | ||
6 | }: | ||
7 | mkDerivation { | ||
8 | pname = "tprint"; | ||
9 | version = "0.0.0"; | ||
10 | src = ./.; | ||
11 | isLibrary = false; | ||
12 | isExecutable = true; | ||
13 | executableHaskellDepends = [ base | ||
14 | thermoprint thermoprint-servant bbcode | ||
15 | optparse-applicative servant-client servant | ||
16 | ]; | ||
17 | homepage = "git://git.yggdrasil.li/thermoprint"; | ||
18 | description = "A cli-tool for interfacing with thermoprint-servant"; | ||
19 | license = stdenv.lib.licenses.publicDomain; | ||
20 | } | ||