regex-wrapper (empty) → 0.1.0.0

raw patch · 6 files changed

+261/−0 lines, 6 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, case-insensitive, containers, hashable, regex-tdfa, string-conv, text

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +34/−0
Setup.hs +2/−0
regex-wrapper.cabal +33/−0
src/Text/Regex/Wrapper.hs +157/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for regex-wrapper++## 0.1.0.0 -- 2019-11-11++* Initial Version released.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Luke Clifton++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Luke Clifton nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,34 @@+### Experimental++This library allows you to create types that are guaranteed to contain a+string that matches a given regular expression which is expressed at the+type level.++```haskell+newtype User = User (Matched String "^[a-zA-Z0-9]{4,15}$")++parseUser :: String -> Either (RegexError String) User+parseUser = fmap User . parseMatchedEither++prettyUser :: User -> String+prettyUser (User m) = asString m++main :: IO ()+main = do+    l <- getLine+    case parseUser l of+        Right user -> putStrLn $ "Hello, " ++ prettyUser user ++ "!"+        Left error -> putStrLn $ "Could not parse username: " ++ prettyRegexError  error+```++```+./prog+bad+Could not parse username: The input "bad" did not match the pattern ^[a-zA-Z0-9]{4,15}$+```++```+./prog+good+Hello, good!+```

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ regex-wrapper.cabal view

@@ -0,0 +1,33 @@+cabal-version:       2.4+name:                regex-wrapper+version:             0.1.0.0+synopsis:            Types that can only be constructed if they match a regular expression+description:         Provides tooling for working with types whose values must+                     match a regular expression provided in the type.+bug-reports:         https://github.com/luke-clifton/regex-wrapper/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Luke Clifton+maintainer:          lukec@themk.net+copyright:           (c) 2019 Luke Clifton+category:            Data+extra-source-files:  CHANGELOG.md, README.md++source-repository head+  type: git+  location: https://github.com/luke-clifton/regex-wrapper++library+  exposed-modules: Text.Regex.Wrapper+  build-depends:+    , base ^>=4.12.0.0+    , regex-tdfa+    , hashable+    , string-conv+    , text+    , bytestring+    , aeson+    , containers+    , case-insensitive+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Text/Regex/Wrapper.hs view

@@ -0,0 +1,157 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+module Text.Regex.Wrapper+    ( Matched()+    , parseMatched+    , parseMatchedEither+    , parseMatchedM+    , asStr+    , asText+    , asString+    , asByteString+    , compile+    , parseMatchedWith+    , parseMatchedEitherWith+    , RegexPat()+    ) where++import Prelude hiding (fail)+import Control.Monad hiding (fail)+import Control.Monad.Fail+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Proxy+import GHC.TypeLits+import Text.Regex.TDFA as TDFA+import Data.Hashable+import Data.Aeson+import Data.CaseInsensitive as CI++data RegexError str = NoMatch (MatchError str) | CompileError String+    deriving Show++prettyRegexError :: Show str => RegexError str -> String+prettyRegexError (NoMatch err) = prettyMatchError err+prettyRegexError (CompileError err) = "Invalid regular expression: " ++ err++data MatchError str = MatchError+    { matchErrorPattern :: String+    , matchErrorInput :: str+    } deriving Show++prettyMatchError :: Show str => MatchError str -> String+prettyMatchError err+    = "The input "+    ++ show (matchErrorInput err)+    ++ " did not match the pattern "+    ++ matchErrorPattern err++-- | A compiled regular expression that can produce @`Matched` str pat@+-- values.+newtype RegexPat (pat :: Symbol) = RegexPat TDFA.Regex++-- | Create a @`Regex`@ that can be used to construct @`Matched`@ values+-- when used with @`parseMatchedWith`@. This allows you to compile+-- the pattern once, and use it multiple times.+compile :: forall pat m. (KnownSymbol pat) => Either String (RegexPat pat)+compile =+    let+        pat = symbolVal (Proxy :: Proxy pat)+    in+        case RegexPat <$> makeRegexM pat of+            Success a -> Right a+            Error s -> Left s++-- | Use a precompiled @`Regex`@ to create @`Matched`@ values.+parseMatchedWith+    :: RegexLike Regex str+    => RegexPat pat -> str -> Maybe (Matched str pat)+parseMatchedWith (RegexPat pat) str = do+    guard $ matchTest pat str+    pure (Matched str)++-- | Like @`parseMatchedWith`@, but calls returns a useful error message.+parseMatchedEitherWith+    :: forall pat str m.+    ( RegexLike Regex str+    , Show str+    , KnownSymbol pat+    ) => RegexPat pat -> str -> Either (MatchError str) (Matched str pat)+parseMatchedEitherWith reg str = do+    let pat = symbolVal (Proxy :: Proxy pat)+    case parseMatchedWith reg str of+        Nothing -> Left MatchError+            { matchErrorPattern = pat+            , matchErrorInput = str+            }+        Just x -> Right x++-- | A wrapper type that can only be constructed if the underlying string+-- type matches the regular expression in @pat@.+newtype Matched str (pat :: Symbol) = Matched str+    deriving newtype (Show, Eq, Ord, Hashable, FoldCase)++-- | Extract the wrapped @str@ type.+asStr :: Matched str pat -> str+asStr (Matched str) = str++instance (KnownSymbol pat, RegexLike Regex str, Read str)+    => Read (Matched str pat) where+    readsPrec p s = do+        r@(a,s) <- readsPrec p s+        Just m <- pure (parseMatched a)+        pure (m, s)++instance ToJSON str => ToJSON (Matched str pat) where+    toJSON = toJSON . asStr+    toEncoding = toEncoding . asStr++instance (KnownSymbol pat, Show str, FromJSON str, RegexLike Regex str)+    => FromJSON (Matched str pat) where+    parseJSON v = parseJSON v >>= either (fail . prettyRegexError) pure . parseMatchedEither++-- | Same as @`asStr`@ but with a fixed type.+asText :: Matched Text p -> Text+asText = asStr++-- | Same as @`asStr`@ but with a fixed type.+asString :: Matched String p -> String+asString = asStr++-- | Same as @`asStr`@ but with a fixed type.+asByteString :: Matched ByteString p -> ByteString+asByteString = asStr++-- | Convert a @str@ into a @`Matched` str pat@ if possible.+parseMatched+    :: forall str pat. (KnownSymbol pat, RegexLike Regex str)+    => str -> Maybe (Matched str pat)+parseMatched str = case compile of+    Left _ -> Nothing+    Right r -> parseMatchedWith r str++-- | Same as @`parseMatched`@ but provides a slightly helpful error+-- message on failure. This requires that your @str@ type is an instance+-- of @`Show`@.+parseMatchedEither+    :: forall pat str. (Show str, KnownSymbol pat, RegexLike Regex str)+    => str -> Either (RegexError str) (Matched str pat)+parseMatchedEither str = do+    case compile of+        Left e -> Left $ CompileError e+        Right r -> case parseMatchedEitherWith r str of+            Left e -> Left $ NoMatch e+            Right r -> pure r++-- | Like @`parseMatchedEither`@ except that it calls @`fail`@ instead.+parseMatchedM+    :: forall pat str m.+    ( KnownSymbol pat, RegexLike Regex str, MonadFail m, Show str)+    => str -> m (Matched str pat)+parseMatchedM str = case parseMatchedEither str of+    Left e -> fail $ prettyRegexError e+    Right r -> pure r