diff options
Diffstat (limited to 'spec/src/Thermoprint/Printout/BBCode/Attribute.hs')
-rw-r--r-- | spec/src/Thermoprint/Printout/BBCode/Attribute.hs | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs index 60815c8..538cca2 100644 --- a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs +++ b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs | |||
@@ -7,7 +7,7 @@ module Thermoprint.Printout.BBCode.Attribute | |||
7 | ) where | 7 | ) where |
8 | 8 | ||
9 | import Data.Text (Text) | 9 | import Data.Text (Text) |
10 | import qualified Data.Text as T (unpack) | 10 | import qualified Data.Text as T (unpack, empty) |
11 | 11 | ||
12 | import Data.Map (Map) | 12 | import Data.Map (Map) |
13 | import qualified Data.Map as Map (lookup) | 13 | import qualified Data.Map as Map (lookup) |
@@ -18,6 +18,8 @@ import qualified Data.CaseInsensitive as CI | |||
18 | import Text.Read (readMaybe) | 18 | import Text.Read (readMaybe) |
19 | import Data.Maybe (fromMaybe) | 19 | import Data.Maybe (fromMaybe) |
20 | 20 | ||
21 | import Control.Applicative (Alternative(..)) | ||
22 | |||
21 | -- | We build our own version of 'Read' so we can override the presentation used | 23 | -- | We build our own version of 'Read' so we can override the presentation used |
22 | -- | 24 | -- |
23 | -- We provide a default implementation for 'Read a => Attribute a' | 25 | -- We provide a default implementation for 'Read a => Attribute a' |
@@ -28,6 +30,10 @@ class Attribute a where | |||
28 | 30 | ||
29 | instance Attribute Integer | 31 | instance Attribute Integer |
30 | 32 | ||
31 | lookupAttr :: Attribute a => CI Text -> a -> Map (CI Text) Text -> a | 33 | lookupAttr :: Attribute a => CI Text -> Bool -> a -> Map (CI Text) Text -> a |
32 | -- ^ Extract an attribute by name | 34 | -- ^ Extract an attribute by name -- the 'Bool' attribute specifies whether we additionally accept the empty string as key |
33 | lookupAttr t def attrs = fromMaybe def $ Map.lookup t attrs >>= attrRead | 35 | lookupAttr 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 | ||