aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore2
-rw-r--r--bbcode/LICENSE27
-rw-r--r--bbcode/Setup.hs2
-rw-r--r--bbcode/bbcode.cabal33
-rw-r--r--bbcode/bbcode.nix18
-rw-r--r--bbcode/src/BBCode.hs120
-rw-r--r--bbcode/src/BBCode/Syntax.hs108
-rw-r--r--bbcode/src/BBCode/Tokenizer.hs44
-rw-r--r--default.nix15
-rw-r--r--servant/LICENSE27
-rw-r--r--servant/Setup.hs2
-rw-r--r--servant/api/Thermoprint/Api.hs35
-rw-r--r--servant/servant.cabal55
-rw-r--r--servant/servant.nix22
-rw-r--r--servant/src/Main.hs158
-rw-r--r--servant/src/PrintOut.hs14
-rw-r--r--shell.nix14
-rw-r--r--thermoprint/LICENSE27
-rw-r--r--thermoprint/Setup.hs2
-rw-r--r--thermoprint/src/Thermoprint.hs122
-rw-r--r--thermoprint/thermoprint.cabal36
-rw-r--r--thermoprint/thermoprint.nix19
-rw-r--r--tprint/LICENSE27
-rw-r--r--tprint/Setup.hs2
-rw-r--r--tprint/src/Main.hs217
-rw-r--r--tprint/tprint.cabal32
-rw-r--r--tprint/tprint.nix20
27 files changed, 0 insertions, 1200 deletions
diff --git a/.gitignore b/.gitignore
index c1614b7..e8ee58b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,2 @@
1**/\#*\# 1**/\#*\#
2**/result 2**/result
3storage.sqlite
4test.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 @@
1Statement of Purpose
2
3The 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
5Certain 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
7For 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
91. 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
11the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work;
12moral rights retained by the original author(s) and/or performer(s);
13publicity and privacy rights pertaining to a person's image or likeness depicted in a Work;
14rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below;
15rights protecting the extraction, dissemination, use and reuse of data in a Work;
16database 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
17other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof.
182. 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
203. 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
224. Limitations and Disclaimers.
23
24No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document.
25Affirmer 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.
26Affirmer 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.
27Affirmer 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 @@
1import Distribution.Simple
2main = 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
4name: bbcode
5version: 0.0.0
6synopsis: A tiny parser for bbcode->thermoprint-syntax-tree conversion
7-- description:
8homepage: git://git.yggdrasil.li/thermoprint
9license: PublicDomain
10license-file: LICENSE
11author: Gregor Kleen
12maintainer: aethoago@141.li
13-- copyright:
14-- category:
15build-type: Simple
16-- extra-source-files:
17cabal-version: >=1.10
18
19library
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}:
7mkDerivation {
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
3module BBCode
4 ( parse
5 , make
6 ) where
7
8import Thermoprint
9
10import BBCode.Tokenizer
11import BBCode.Syntax
12
13import Data.Maybe
14import Data.Monoid
15import Data.Either
16import Data.Bifunctor
17import Data.List
18import Data.Ord
19import Data.Foldable
20
21import Data.Function (on)
22
23import Data.CaseInsensitive ( CI )
24import qualified Data.CaseInsensitive as CI
25
26import Data.Map ( Map )
27import qualified Data.Map as Map
28
29import Prelude hiding (takeWhile)
30
31import Debug.Trace
32
33knownTags :: Map (CI String) (Either (Block String -> Block String) (Inline String -> Inline String))
34knownTags = [ ("center", Left Center)
35 , ("u", Right Underline)
36 ]
37
38isBlock, isInline :: String -> Bool
39isBlock = testTag isLeft
40isInline = testTag isRight
41testTag f k = fromMaybe False (f <$> Map.lookup (CI.mk k) knownTags)
42
43data Decorated c = Decorated c [String]
44 deriving (Show, Eq)
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
57parse :: String -> Either String (Block String)
58parse input = massage <$> ((remerge . blockify <$> (tokenize input >>= treeify)) >>= semantics)
59
60massage :: Block String -> Block String
61massage (Over [x]) = massage x
62massage (Over xs) = Over $ map massage xs
63massage (Center x) = Center $ massage x
64massage (Paragraph x) = Paragraph $ massage' x
65
66massage' :: Inline String -> Inline String
67massage' (Beside [x]) = massage' x
68massage' (Beside xs) = Beside $ map massage' xs
69massage' (Underline x) = Underline $ massage' x
70massage' z = z
71
72blockify :: ContentForest -> [Decorated String]
73blockify = 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
83remerge :: [Decorated String] -> ContentForest
84remerge [] = []
85remerge [(Decorated c deco)] = [appEndo applyDeco $ Content c]
86 where
87 applyDeco = foldMap (\t -> Endo (\c -> Tagged [c] t)) $ reverse deco
88remerge 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
100unknownTag :: forall a. String -> Either String a
101unknownTag tag = Left $ "Unknown tag: " ++ tag
102
103semantics :: ContentForest -> Either String (Block String)
104semantics forest = Over <$> mapM semantics' forest
105
106semantics' :: ContentTree -> Either String (Block String)
107semantics' Empty = Right $ Over []
108semantics' (Content str) = Right $ Paragraph (Cooked str)
109semantics' (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
114iSemantics :: ContentTree -> Either String (Inline String)
115iSemantics Empty = Right $ Beside []
116iSemantics (Content str) = Right $ Cooked str
117iSemantics (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
3module BBCode.Syntax
4 ( treeify
5 , ContentForest
6 , ContentTree(..)
7 ) where
8
9import BBCode.Tokenizer (Token(..))
10
11import Data.Foldable
12import Data.Bifunctor
13import Data.Monoid
14
15import Control.Monad.State
16import Control.Monad.Trans
17import Control.Monad
18
19import Data.CaseInsensitive ( CI )
20import qualified Data.CaseInsensitive as CI
21
22import Data.Function (on)
23
24type ContentForest = [ContentTree]
25data ContentTree = Content String
26 | Tagged [ContentTree] String
27 | Empty
28 deriving (Show, Eq)
29
30data Step = Down [ContentTree] [ContentTree] String
31 deriving (Show)
32
33data Zipper = Zipper
34 { hole :: String
35 , prevs :: [ContentTree]
36 , steps :: [Step]
37 }
38 deriving (Show)
39
40type Parser = StateT Zipper (Either String)
41abort :: String -> Parser a
42abort = lift . Left
43
44
45treeify :: [Token] -> Either String ContentForest
46treeify tokenStream = second (postProcess . unZip) $ execStateT (mapM_ incorporate tokenStream) (Zipper "" [] [])
47
48postProcess :: ContentForest -> ContentForest
49postProcess 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
62unZip :: Zipper -> ContentForest
63unZip Zipper{..} = reverse (apply hole steps : prevs)
64
65apply :: String -> [Step] -> ContentTree
66apply hole steps = hole `apply'` (reverse steps)
67apply' "" [] = Empty
68apply' hole [] = Content hole
69apply' hole (Down pres posts tag:steps) = Tagged (reverse pres ++ [hole `apply` steps] ++ posts) tag
70
71incorporate :: Token -> Parser ()
72incorporate (Text str) = append str
73incorporate (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
83incorporate (TagOpen tagName) = modify $ (\z@(Zipper{..}) -> z { steps = (Down [] [] tagName : steps) })
84incorporate (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
93append :: String -> Parser ()
94append str = modify (\z@(Zipper{..}) -> z { hole = hole ++ str })
95
96goUp :: Parser ()
97goUp = 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
3module BBCode.Tokenizer
4 ( Token(..)
5 , tokenize
6 ) where
7
8import qualified Data.Text.Lazy as TL
9import qualified Data.Text as T
10
11import Control.Applicative
12import Data.Attoparsec.Text.Lazy
13
14import Data.Char (isSpace)
15import Data.Monoid (mconcat)
16
17data Token = Text String
18 | Whitespace String
19 | TagOpen String
20 | TagClose String
21 deriving (Show, Read, Eq)
22
23tokenize :: String -> Either String [Token]
24tokenize = eitherResult . parse (tokenize' <* endOfInput) . TL.pack
25
26tokenize' :: Parser [Token]
27tokenize' = many $ choice [ whitespace
28 , Text . T.unpack <$> ("\\" *> "[")
29 , tagClose
30 , tagOpen
31 , text
32 ]
33
34whitespace :: Parser Token
35whitespace = Whitespace <$> many1 space
36
37tagOpen :: Parser Token
38tagOpen = TagOpen . T.unpack <$> ("[" *> takeWhile1 (/= ']') <* "]")
39
40tagClose :: Parser Token
41tagClose = TagClose . T.unpack <$> ("[/" *> takeWhile1 (/= ']') <* "]")
42
43text :: Parser Token
44text = 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
4rec {
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 @@
1Statement of Purpose
2
3The 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
5Certain 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
7For 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
91. 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
11the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work;
12moral rights retained by the original author(s) and/or performer(s);
13publicity and privacy rights pertaining to a person's image or likeness depicted in a Work;
14rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below;
15rights protecting the extraction, dissemination, use and reuse of data in a Work;
16database 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
17other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof.
182. 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
203. 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
224. Limitations and Disclaimers.
23
24No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document.
25Affirmer 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.
26Affirmer 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.
27Affirmer 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 @@
1import Distribution.Simple
2main = 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
3module Thermoprint.Api
4 ( ThermoprintApi
5 ) where
6
7import Thermoprint
8import Data.Aeson
9import Servant.API
10import qualified Data.Text.Lazy as Text
11import qualified Data.ByteString.Lazy.Char8 as ByteString
12import Data.ByteString.Lazy.Char8 (ByteString)
13import GHC.Generics
14
15import Control.Monad
16
17import Data.Int (Int64)
18
19instance ToJSON ByteString where
20 toJSON = toJSON . Text.pack . ByteString.unpack
21instance FromJSON ByteString where
22 parseJSON value = (ByteString.pack . Text.unpack) `liftM` parseJSON value
23
24instance ToJSON c => ToJSON (Inline c)
25instance FromJSON c => FromJSON (Inline c)
26
27instance ToJSON c => ToJSON (Block c)
28instance FromJSON c => FromJSON (Block c)
29
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
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
4name: thermoprint-servant
5version: 0.0.0
6synopsis: Server for interfacing to cheap thermoprinters
7-- description:
8homepage: git://git.yggdrasil.li/thermoprint
9license: PublicDomain
10license-file: LICENSE
11author: Gregor Kleen
12maintainer: aethoago@141.li
13-- copyright:
14category: Web
15build-type: Simple
16-- extra-source-files:
17cabal-version: >=1.10
18
19library
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
33executable 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
9mkDerivation {
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
11import Thermoprint
12import Thermoprint.Api
13import PrintOut
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
22import Data.Aeson
23import Network.Wai
24import Network.Wai.Handler.Warp
25import Servant
26import GHC.Generics
27
28import Control.Monad
29import Control.Monad.Trans.Class
30import Control.Monad.IO.Class
31import Control.Monad.Trans.Either
32
33import Control.Monad.Logger
34
35import Options.Applicative
36
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
54
55print :: Options -> Integer -> Block String -> EitherT ServantErr IO ()
56print 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
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
98data Options = Options
99 { port :: Int
100 , connStr :: String
101 , connNmbr :: Int
102 , printers :: [FilePath]
103 }
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
113options :: Parser Options
114options = 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
143thermoprintApi :: Proxy ThermoprintApi
144thermoprintApi = Proxy
145
146main :: IO ()
147main = 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 #-}
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/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
5let
6 ghc = pkgs.haskell.packages.${compiler}.ghcWithPackages (ps: with ps; [
7 cabal-install hlint cabal2nix
8 ] ++ (builtins.attrValues (import ./default.nix {})));
9in
10pkgs.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 @@
1Statement of Purpose
2
3The 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
5Certain 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
7For 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
91. 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
11the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work;
12moral rights retained by the original author(s) and/or performer(s);
13publicity and privacy rights pertaining to a person's image or likeness depicted in a Work;
14rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below;
15rights protecting the extraction, dissemination, use and reuse of data in a Work;
16database 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
17other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof.
182. 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
203. 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
224. Limitations and Disclaimers.
23
24No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document.
25Affirmer 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.
26Affirmer 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.
27Affirmer 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 @@
1import Distribution.Simple
2main = 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 #-}
2module Thermoprint
3 ( Block(..)
4 , Inline(..)
5 , PrinterConf(..)
6 , render
7 , render'
8 , module Data.Monoid
9 ) where
10
11import Data.Default
12import qualified Data.ByteString.Lazy as Lazy (ByteString)
13import Data.ByteString.Lazy.Char8 (pack)
14import Data.Monoid
15import GHC.Generics
16
17import Data.Binary.Put
18import Data.Encoding
19import Data.Encoding.CP437
20import Data.Word
21
22import 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
31data Block c = Over [Block c]
32 | Center (Block c)
33 | Paragraph (Inline c)
34 deriving (Show, Read, Eq, Functor, Generic)
35data Inline c = Beside [Inline c]
36 | Underline (Inline c)
37 | Cooked c
38 | Raw Lazy.ByteString
39 deriving (Show, Read, Eq, Functor, Generic)
40
41instance 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
48instance 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
56data 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
67instance 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
108render :: PrinterConf c -> Block c -> Lazy.ByteString
109render 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
121render' :: Block String -> Lazy.ByteString
122render' = 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 @@
1name: thermoprint
2version: 0.0.0
3synopsis: Description of formatting supported by cheap thermoprinters
4-- description:
5homepage: git://git.yggdrasil.li/thermoprint
6license: PublicDomain
7license-file: LICENSE
8author: Gregor Kleen
9maintainer: aethoago@141.li
10-- copyright:
11-- category:
12
13build-type: Simple
14
15-- extra-source-files:
16cabal-version: >=1.10
17
18
19library
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
7mkDerivation {
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 @@
1Statement of Purpose
2
3The 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
5Certain 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
7For 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
91. 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
11the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work;
12moral rights retained by the original author(s) and/or performer(s);
13publicity and privacy rights pertaining to a person's image or likeness depicted in a Work;
14rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below;
15rights protecting the extraction, dissemination, use and reuse of data in a Work;
16database 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
17other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof.
182. 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
203. 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
224. Limitations and Disclaimers.
23
24No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document.
25Affirmer 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.
26Affirmer 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.
27Affirmer 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 @@
1import Distribution.Simple
2main = 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
3import Thermoprint
4import Thermoprint.Api
5
6import qualified BBCode (parse, make)
7
8import Options.Applicative
9
10import Data.Either
11import Data.Maybe
12import Control.Monad
13import Control.Monad.Trans.Either
14
15import System.IO
16import qualified System.IO as IO
17import System.Exit
18import System.Environment
19
20import Data.Proxy
21import Servant.API
22import Servant.Client
23
24import Data.Int (Int64)
25
26thermoprintApi :: Proxy ThermoprintApi
27thermoprintApi = Proxy
28
29data TPrint = TPrint TPrintMode TPrintOptions
30
31data TPrintOptions = TPrintOptions
32 { baseUrl :: BaseUrl
33 }
34
35data TPrintMode = Print PrintOptions
36 | PrintDraft PrintDraftOptions
37 | Query QueryOptions
38 | Add AddOptions
39 | Get GetOptions
40 | Write WriteOptions
41 | Del DelOptions
42
43data PrintOptions = PrintOptions
44 { printerId :: Integer
45 , dryRun :: Bool
46 }
47
48data PrintDraftOptions = PrintDraftOptions
49 { printOptions :: PrintOptions
50 , pDraftId :: Int64
51 , deleteAfter :: Bool
52 }
53
54data QueryOptions = QueryOptions
55
56data AddOptions = AddOptions
57 { title :: String
58 }
59
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
74
75main :: IO ()
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'
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
160either' :: (a -> String) -> EitherT a IO b -> IO b
161either' f a = either (die . f) return =<< runEitherT a
162
163main' (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
4name: tprint
5version: 0.0.0
6synopsis: A cli-tool for interfacing with thermoprint-servant
7-- description:
8homepage: git://git.yggdrasil.li/thermoprint
9license: PublicDomain
10license-file: LICENSE
11author: Gregor Kleen
12maintainer: aethoago@141.li
13-- copyright:
14-- category:
15build-type: Simple
16-- extra-source-files:
17cabal-version: >=1.10
18
19executable 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}:
7mkDerivation {
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}