-- | This internal module is mostly here to prevent CPP conflicting with Haskell
-- comments.
{-# LANGUAGE CPP #-}
module Hakyll.Core.Identifier.Pattern.Internal
    ( GlobComponent (..)
    , Pattern (..)
    ) where


--------------------------------------------------------------------------------
import           Data.Binary            (Binary (..), getWord8, putWord8)
import           Data.Set               (Set)


--------------------------------------------------------------------------------
#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup         (Semigroup (..))
#endif


--------------------------------------------------------------------------------
import           Hakyll.Core.Identifier


--------------------------------------------------------------------------------
-- | Elements of a glob pattern
data GlobComponent
    = Capture
    | CaptureMany
    | Literal String
    deriving (GlobComponent -> GlobComponent -> Bool
(GlobComponent -> GlobComponent -> Bool)
-> (GlobComponent -> GlobComponent -> Bool) -> Eq GlobComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobComponent -> GlobComponent -> Bool
$c/= :: GlobComponent -> GlobComponent -> Bool
== :: GlobComponent -> GlobComponent -> Bool
$c== :: GlobComponent -> GlobComponent -> Bool
Eq, Int -> GlobComponent -> ShowS
[GlobComponent] -> ShowS
GlobComponent -> String
(Int -> GlobComponent -> ShowS)
-> (GlobComponent -> String)
-> ([GlobComponent] -> ShowS)
-> Show GlobComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobComponent] -> ShowS
$cshowList :: [GlobComponent] -> ShowS
show :: GlobComponent -> String
$cshow :: GlobComponent -> String
showsPrec :: Int -> GlobComponent -> ShowS
$cshowsPrec :: Int -> GlobComponent -> ShowS
Show)


--------------------------------------------------------------------------------
instance Binary GlobComponent where
    put :: GlobComponent -> Put
put GlobComponent
Capture     = Word8 -> Put
putWord8 Word8
0
    put GlobComponent
CaptureMany = Word8 -> Put
putWord8 Word8
1
    put (Literal String
s) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
s

    get :: Get GlobComponent
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get GlobComponent) -> Get GlobComponent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
t -> case Word8
t of
        Word8
0 -> GlobComponent -> Get GlobComponent
forall (f :: * -> *) a. Applicative f => a -> f a
pure GlobComponent
Capture
        Word8
1 -> GlobComponent -> Get GlobComponent
forall (f :: * -> *) a. Applicative f => a -> f a
pure GlobComponent
CaptureMany
        Word8
2 -> String -> GlobComponent
Literal (String -> GlobComponent) -> Get String -> Get GlobComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
        Word8
_ -> String -> Get GlobComponent
forall a. HasCallStack => String -> a
error String
"Data.Binary.get: Invalid GlobComponent"


--------------------------------------------------------------------------------
-- | Type that allows matching on identifiers
data Pattern
    = Everything
    | Complement Pattern
    | And Pattern Pattern
    | Glob [GlobComponent]
    | List (Set Identifier)
    | Regex String
    | Version (Maybe String)
    deriving (Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)


--------------------------------------------------------------------------------
instance Binary Pattern where
    put :: Pattern -> Put
put Pattern
Everything     = Word8 -> Put
putWord8 Word8
0
    put (Complement Pattern
p) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> Put
forall t. Binary t => t -> Put
put Pattern
p
    put (And Pattern
x Pattern
y)      = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> Put
forall t. Binary t => t -> Put
put Pattern
x Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> Put
forall t. Binary t => t -> Put
put Pattern
y
    put (Glob [GlobComponent]
g)       = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [GlobComponent] -> Put
forall t. Binary t => t -> Put
put [GlobComponent]
g
    put (List Set Identifier
is)      = Word8 -> Put
putWord8 Word8
4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Set Identifier -> Put
forall t. Binary t => t -> Put
put Set Identifier
is
    put (Regex String
r)      = Word8 -> Put
putWord8 Word8
5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
r
    put (Version Maybe String
v)    = Word8 -> Put
putWord8 Word8
6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> Put
forall t. Binary t => t -> Put
put Maybe String
v

    get :: Get Pattern
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Pattern) -> Get Pattern
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
t -> case Word8
t of
        Word8
0 -> Pattern -> Get Pattern
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
Everything
        Word8
1 -> Pattern -> Pattern
Complement (Pattern -> Pattern) -> Get Pattern -> Get Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Pattern
forall t. Binary t => Get t
get
        Word8
2 -> Pattern -> Pattern -> Pattern
And (Pattern -> Pattern -> Pattern)
-> Get Pattern -> Get (Pattern -> Pattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Pattern
forall t. Binary t => Get t
get Get (Pattern -> Pattern) -> Get Pattern -> Get Pattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pattern
forall t. Binary t => Get t
get
        Word8
3 -> [GlobComponent] -> Pattern
Glob ([GlobComponent] -> Pattern) -> Get [GlobComponent] -> Get Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [GlobComponent]
forall t. Binary t => Get t
get
        Word8
4 -> Set Identifier -> Pattern
List (Set Identifier -> Pattern) -> Get (Set Identifier) -> Get Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Set Identifier)
forall t. Binary t => Get t
get
        Word8
5 -> String -> Pattern
Regex (String -> Pattern) -> Get String -> Get Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
        Word8
_ -> Maybe String -> Pattern
Version (Maybe String -> Pattern) -> Get (Maybe String) -> Get Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe String)
forall t. Binary t => Get t
get


--------------------------------------------------------------------------------
#if MIN_VERSION_base(4,9,0)
instance Semigroup Pattern where
    <> :: Pattern -> Pattern -> Pattern
(<>) = Pattern -> Pattern -> Pattern
And

instance Monoid Pattern where
    mempty :: Pattern
mempty  = Pattern
Everything
    mappend :: Pattern -> Pattern -> Pattern
mappend = Pattern -> Pattern -> Pattern
forall a. Semigroup a => a -> a -> a
(<>)
#else
instance Monoid Pattern where
    mempty  = Everything
    mappend = And
#endif