-- Copyright (C) 2017  Fraser Tweedale
--
-- hs-notmuch is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Notmuch.Tag
  (
    Tag
  , getTag
  , mkTag
  , tagUseAsCString
  , tagFromCString
  , tagMaxLen
  ) where

import Control.DeepSeq (NFData)
import Data.Maybe (fromJust)
import Data.String (IsString(..))
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import Foreign.C (CString)

import Notmuch.Binding.Constants (tagMaxLen)

-- | Message tag.  Use 'mkTag' to construct a tag.  Or use
-- @-XOverloadedStrings@, but beware that the @IsString@ instance
-- is non-total.
--
-- This data type avoid copying when passing tags to /libnotmuch/.
-- But copies do occur when reading tags from a database.
--
-- A previous experiment with interning showed no benefit.  Tags
-- are typically very short so the overhead erodes any advantage.
--
newtype Tag = Tag B.ByteString
  deriving (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
Ord, Tag -> ()
(Tag -> ()) -> NFData Tag
forall a. (a -> ()) -> NFData a
rnf :: Tag -> ()
$crnf :: Tag -> ()
NFData)

instance Show Tag where
  show :: Tag -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> (Tag -> ByteString) -> Tag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> ByteString
getTag

-- | Throws exception if the tag is empty or too long.
instance IsString Tag where
  fromString :: String -> Tag
fromString = Maybe Tag -> Tag
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Tag -> Tag) -> (String -> Maybe Tag) -> String -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Tag
mkTag (ByteString -> Maybe Tag)
-> (String -> ByteString) -> String -> Maybe Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

-- | /O(1)/
getTag :: Tag -> B.ByteString
getTag :: Tag -> ByteString
getTag (Tag ByteString
s) = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.init ByteString
s  -- trim null byte

-- | /O(n)/ @Just@ a tag, or @Nothing@ if the string is too long
--
-- Use UTF-8 encoding to include non-ASCII characters in a tag.
--
mkTag :: B.ByteString -> Maybe Tag
mkTag :: ByteString -> Maybe Tag
mkTag ByteString
s =
  if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
tagMaxLen
    then Maybe Tag
forall a. Maybe a
Nothing
    else Tag -> Maybe Tag
forall a. a -> Maybe a
Just (Tag -> Maybe Tag) -> Tag -> Maybe Tag
forall a b. (a -> b) -> a -> b
$ ByteString -> Tag
Tag (ByteString
s ByteString -> Word8 -> ByteString
`B.snoc` Word8
0)
  where
    w :: Int
w = ByteString -> Int
B.length ByteString
s

-- | /O(1)/
tagUseAsCString :: Tag -> (CString -> IO a) -> IO a
tagUseAsCString :: forall a. Tag -> (CString -> IO a) -> IO a
tagUseAsCString (Tag ByteString
bs) = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs
{-# INLINE tagUseAsCString #-}

-- | /O(n)/ @CString@ must be null-terminated and non-empty.
-- We must copy the tag into pinned memory so that it can be
-- used again as a CString without copying.
--
tagFromCString :: CString -> IO Tag
tagFromCString :: CString -> IO Tag
tagFromCString CString
cstr = ByteString -> Tag
Tag (ByteString -> Tag) -> IO ByteString -> IO Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  CSize
len <- CString -> IO CSize
B.c_strlen CString
cstr
  CStringLen -> IO ByteString
B.packCStringLen (CString
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 {- include null byte -})