diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Hakyll/Core/Identifier/Pattern.hs | 93 | ||||
| -rw-r--r-- | lib/Hakyll/Core/Identifier/Pattern/Internal.hs | 92 |
2 files changed, 102 insertions, 83 deletions
diff --git a/lib/Hakyll/Core/Identifier/Pattern.hs b/lib/Hakyll/Core/Identifier/Pattern.hs index a36e464..4125a8b 100644 --- a/lib/Hakyll/Core/Identifier/Pattern.hs +++ b/lib/Hakyll/Core/Identifier/Pattern.hs @@ -28,7 +28,7 @@ -- -- The 'capture' function allows the user to get access to the elements captured -- by the capture elements in a glob or regex pattern. -{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Hakyll.Core.Identifier.Pattern ( -- * The pattern type Pattern @@ -58,80 +58,22 @@ module Hakyll.Core.Identifier.Pattern -------------------------------------------------------------------------------- -import Control.Arrow ((&&&), (>>>)) -import Control.Monad (msum) -import Data.Binary (Binary (..), getWord8, putWord8) -import Data.List (inits, isPrefixOf, tails) -import Data.Maybe (isJust) -#if MIN_VERSION_base(4,9,0) -import Data.Semigroup (Semigroup (..)) -#endif -import Data.Set (Set) -import qualified Data.Set as S +import Control.Arrow ((&&&), (>>>)) +import Control.Monad (msum) +import Data.List (inits, isPrefixOf, + tails) +import Data.Maybe (isJust) +import qualified Data.Set as S -------------------------------------------------------------------------------- -import GHC.Exts (IsString, fromString) -import Text.Regex.TDFA ((=~)) +import GHC.Exts (IsString, fromString) +import Text.Regex.TDFA ((=~)) -------------------------------------------------------------------------------- import Hakyll.Core.Identifier - - --------------------------------------------------------------------------------- --- | Elements of a glob pattern -data GlobComponent - = Capture - | CaptureMany - | Literal String - deriving (Eq, Show) - - --------------------------------------------------------------------------------- -instance Binary GlobComponent where - put Capture = putWord8 0 - put CaptureMany = putWord8 1 - put (Literal s) = putWord8 2 >> put s - - get = getWord8 >>= \t -> case t of - 0 -> pure Capture - 1 -> pure CaptureMany - 2 -> Literal <$> get - _ -> error "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 (Show) - - --------------------------------------------------------------------------------- -instance Binary Pattern where - put Everything = putWord8 0 - put (Complement p) = putWord8 1 >> put p - put (And x y) = putWord8 2 >> put x >> put y - put (Glob g) = putWord8 3 >> put g - put (List is) = putWord8 4 >> put is - put (Regex r) = putWord8 5 >> put r - put (Version v) = putWord8 6 >> put v - - get = getWord8 >>= \t -> case t of - 0 -> pure Everything - 1 -> Complement <$> get - 2 -> And <$> get <*> get - 3 -> Glob <$> get - 4 -> List <$> get - 5 -> Regex <$> get - _ -> Version <$> get +import Hakyll.Core.Identifier.Pattern.Internal -------------------------------------------------------------------------------- @@ -140,21 +82,6 @@ instance IsString Pattern where -------------------------------------------------------------------------------- -#if MIN_VERSION_base(4,9,0) -instance Semigroup Pattern where - (<>) = (.&&.) - -instance Monoid Pattern where - mempty = Everything - mappend = (<>) -#else -instance Monoid Pattern where - mempty = Everything - mappend = (.&&.) -#endif - - --------------------------------------------------------------------------------- -- | Parse a pattern from a string fromGlob :: String -> Pattern fromGlob = Glob . parse' diff --git a/lib/Hakyll/Core/Identifier/Pattern/Internal.hs b/lib/Hakyll/Core/Identifier/Pattern/Internal.hs new file mode 100644 index 0000000..3c1d765 --- /dev/null +++ b/lib/Hakyll/Core/Identifier/Pattern/Internal.hs @@ -0,0 +1,92 @@ +-- | 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 (Eq, Show) + + +-------------------------------------------------------------------------------- +instance Binary GlobComponent where + put Capture = putWord8 0 + put CaptureMany = putWord8 1 + put (Literal s) = putWord8 2 >> put s + + get = getWord8 >>= \t -> case t of + 0 -> pure Capture + 1 -> pure CaptureMany + 2 -> Literal <$> get + _ -> error "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 (Show) + + +-------------------------------------------------------------------------------- +instance Binary Pattern where + put Everything = putWord8 0 + put (Complement p) = putWord8 1 >> put p + put (And x y) = putWord8 2 >> put x >> put y + put (Glob g) = putWord8 3 >> put g + put (List is) = putWord8 4 >> put is + put (Regex r) = putWord8 5 >> put r + put (Version v) = putWord8 6 >> put v + + get = getWord8 >>= \t -> case t of + 0 -> pure Everything + 1 -> Complement <$> get + 2 -> And <$> get <*> get + 3 -> Glob <$> get + 4 -> List <$> get + 5 -> Regex <$> get + _ -> Version <$> get + + +-------------------------------------------------------------------------------- +#if MIN_VERSION_base(4,9,0) +instance Semigroup Pattern where + (<>) = And + +instance Monoid Pattern where + mempty = Everything + mappend = (<>) +#else +instance Monoid Pattern where + mempty = Everything + mappend = And +#endif |