aboutsummaryrefslogtreecommitdiff
path: root/spec/src/Thermoprint/Printout/BBCode/Attribute.hs
diff options
context:
space:
mode:
Diffstat (limited to 'spec/src/Thermoprint/Printout/BBCode/Attribute.hs')
-rw-r--r--spec/src/Thermoprint/Printout/BBCode/Attribute.hs39
1 files changed, 0 insertions, 39 deletions
diff --git a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs
deleted file mode 100644
index 538cca2..0000000
--- a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs
+++ /dev/null
@@ -1,39 +0,0 @@
1{-# LANGUAGE DefaultSignatures #-}
2
3-- | Parsing attributes
4module Thermoprint.Printout.BBCode.Attribute
5 ( Attribute(..)
6 , lookupAttr
7 ) where
8
9import Data.Text (Text)
10import qualified Data.Text as T (unpack, empty)
11
12import Data.Map (Map)
13import qualified Data.Map as Map (lookup)
14
15import Data.CaseInsensitive (CI)
16import qualified Data.CaseInsensitive as CI
17
18import Text.Read (readMaybe)
19import Data.Maybe (fromMaybe)
20
21import Control.Applicative (Alternative(..))
22
23-- | We build our own version of 'Read' so we can override the presentation used
24--
25-- We provide a default implementation for 'Read a => Attribute a'
26class Attribute a where
27 attrRead :: Text -> Maybe a
28 default attrRead :: Read a => Text -> Maybe a
29 attrRead = readMaybe . T.unpack
30
31instance Attribute Integer
32
33lookupAttr :: Attribute a => CI Text -> Bool -> a -> Map (CI Text) Text -> a
34-- ^ Extract an attribute by name -- the 'Bool' attribute specifies whether we additionally accept the empty string as key
35lookupAttr t emptyOk def attrs = fromMaybe def $ (emptyOk' $ Map.lookup t attrs) >>= attrRead
36 where
37 emptyOk'
38 | emptyOk = (<|> Map.lookup (CI.mk T.empty) attrs)
39 | otherwise = id