liblawless 0.20.2 → 0.21.0

raw patch · 7 files changed

+150/−42 lines, 7 filesdep ~QuickCheckdep ~hjsonschemadep ~liblawlessPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, hjsonschema, liblawless, text-icu-normalized

API changes (from Hackage documentation)

Files

• Source/Aeson.hs +2/−2
• Source/Environment.hs +75/−0
• Source/IO.hs +52/−20
• Source/Text/IO.hs +2/−2
• Tests/Line.hs +5/−6
• Tests/TestTextMachine.hs +4/−4
• liblawless.cabal +10/−8

@@ -1,7 +1,7 @@ module Aeson (     module Data.Aeson,     module Data.Aeson.Types,-    module Data.JsonSchema.Draft4,+    module JSONSchema.Draft4,     module Generics,     lawlessJSONOptions,     lawlessToJSONEncoding,@@ -14,7 +14,7 @@ import Data.Aeson import Data.Aeson.Types import GHC.Generics (Rep)-import Data.JsonSchema.Draft4+import JSONSchema.Draft4  dropLensPrefix ∷ [Char] → [Char] dropLensPrefix =

@@ -0,0 +1,75 @@+{-|+Module:             Environment+Description:        Execution environment, but as Text and lifted to MonadIO.+Copyright:          © 2017 All rights reserved.+License:            GPL-3+Maintainer:         Evan Cofsky <evan@theunixman.com>+Stability:          experimental+Portability:        POSIX+-}++module Environment where++import Lawless+import IO+import Text+import Textual++import qualified System.Environment as SE++-- | A key in the 'Environment'.+newtype EnvName = EnvName {unEnvName ∷ Text} deriving (Eq, Ord, Show, Printable)+instance IsText EnvName where+    packed = iso (EnvName ∘ view packed) (view unpacked ∘ unEnvName)+    builder = iso (view builder ∘ unEnvName) (EnvName ∘ review builder)++-- | A value in the 'Environment'+newtype EnvValue = EnvValue {unEnvValue ∷ Text} deriving (Eq, Ord, Show, Printable)+instance IsText EnvValue where+    packed = iso (EnvValue ∘ view packed) (view unpacked ∘ unEnvValue)+    builder = iso (view builder ∘ unEnvValue) (EnvValue ∘ review builder)++lookupEnv ∷ MonadIO m ⇒ EnvName → m (Maybe EnvValue)+lookupEnv k =+    liftIO $ maybe Nothing (Just ∘ EnvValue ∘ view packed)+    <$> SE.lookupEnv (k ^. unpacked)++setEnv ∷ MonadIO m ⇒ EnvName → EnvValue → m ()+setEnv k v = liftIO $ SE.setEnv (k ^. unpacked) (v ^. unpacked)++-- | 'Lens' for the system environment.+--+--+-- lens ∷ Functor f => (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t+--+--+-- Lens s t a b = Functor f ⇒ (a → f b) → s → f t+--+-- 'lookupEnv'+-- s → a: EnvName → m (Maybe EnvValue)+--+-- 'setEnv'+-- s → b → t: EnvName → EnvValue → m ()+--+-- s: EnvName+-- t: m ()+-- a: m (Maybe EnvValue)+-- b: EnvValue+environment ∷ MonadIO m ⇒ Lens EnvName (m ()) (m (Maybe EnvValue)) EnvValue+environment = lens lookupEnv setEnv++newtype Arg = Arg {unArg ∷ Text} deriving (Eq, Show, Ord, Printable)+instance IsText Arg where+    packed = iso (Arg ∘ view packed) (view unpacked ∘ unArg)+    builder = iso (view builder ∘ unArg) (Arg ∘ review builder)++args ∷ (MonadIO m) ⇒ m [Arg]+args = liftIO $ over traversed (view packed) <$> SE.getArgs++newtype ProgName = ProgName {unProgName ∷ Text} deriving (Eq, Show, Ord, Printable)+instance IsText ProgName where+    packed = iso (ProgName ∘ view packed) (view unpacked ∘ unProgName)+    builder = iso (view builder ∘ unProgName) (ProgName ∘ review builder)++progName ∷ (MonadIO m) ⇒ m ProgName+progName = liftIO $ view packed <$> SE.getProgName

@@ -36,6 +36,7 @@      withOffset,     withPosition,+    withCurrentPosition,      MonadIO,     liftIO,@@ -68,11 +69,13 @@ import qualified System.IO as SIO import System.IO (Handle, stdin, stdout, stderr, SeekMode(..), IOMode(..)) import Data.Typeable+import Data.Text.Lazy.Builder (Builder)  default (Text)  -- * Printable I/O to stdio +-- | Exception representing a failure to parse a 'Textual'. data ParseError = ParseError {     _peReason ∷ Text,     _peStack ∷ [Text]@@ -91,57 +94,86 @@  instance Exception ParseError +-- | Try parsing a 'Textual', and throw 'ParseError' if it can't be parsed. sTxt ∷ (MonadThrow m, Textual t) ⇒ Text → m t sTxt t = case parseText t of     Malformed s r → throwM $ ParseError (r ^. packed) $ over traversed (view packed) s     Parsed v → return v +-- | Read and parse a 'Textual" from 'stdin'. getLine ∷ (MonadIO m, MonadThrow m, Textual t) ⇒ m t getLine = TIO.getLine ≫= sTxt +-- | Read and parse a 'Textual' from a 'Handle'. hGetLine ∷ (MonadIO m, MonadThrow m, Textual t) ⇒ Handle → m t hGetLine h = TIO.hGetLine h ≫= sTxt -pTxt ∷ (Printable p)⇒ p → Text-pTxt = buildText ∘ print+-- putStr ∷ (MonadIO m, Printer p) ⇒ p → m () -putStr ∷ (MonadIO m, Printable p) ⇒ p → m ()-putStr = TIO.putStr ∘ pTxt+-- | Write a 'Printer' to 'stdout'.+putStr ∷ (MonadIO m) ⇒ Builder  → m ()+putStr = TIO.putStr ∘ buildText -putStrLn ∷ (MonadIO m, Printable p) ⇒ p → m ()-putStrLn = TIO.putStrLn ∘ pTxt+-- putStrLn ∷ (MonadIO m, Printer p) ⇒ p → m () -hPutStr ∷ (MonadIO m, Printable p) ⇒ Handle → p → m ()-hPutStr h = TIO.hPutStr h ∘ pTxt+-- | Write a 'Printer' plus a newline to 'stdout'.+putStrLn ∷ MonadIO m ⇒ Builder  → m ()+putStrLn = TIO.putStrLn ∘ buildText -hPutStrLn ∷ (MonadIO m, Printable p) ⇒ Handle → p → m ()-hPutStrLn h = TIO.hPutStrLn h ∘ pTxt+-- | Write a 'Printer' to a 'Handle'.+hPutStr ∷ (MonadIO m) ⇒ Handle → Builder → m ()+hPutStr h = TIO.hPutStr h ∘ buildText +-- | Write a 'Printer' plus a newline to 'stderr'.+hPutStrLn ∷ (MonadIO m) ⇒ Handle → Builder → m ()+hPutStrLn h = TIO.hPutStrLn h ∘ buildText+ -- * Seek managers +-- | A relative position in a file 'Handle'. newtype FileOffset = FileOffset Integer-    deriving (Eq, Ord, Show, Enum, Real, Num, Integral)+    deriving (Eq, Ord, Show, Enum, Real, Num, Integral, Printable)++-- | An absolute position in a file 'Handle'. newtype FilePosition = FilePosition Integer-    deriving (Eq, Ord, Show, Enum, Real, Num, Integral)+    deriving (Eq, Ord, Show, Enum, Real, Num, Integral, Printable) -seek ∷ (MonadIO m) ⇒ Handle → FileOffset → m ()-seek h o = liftIO $ SIO.hSeek h RelativeSeek (fromIntegral o)+-- | Seek relative to the current position in 'Handle'.+rseek ∷ (MonadIO m) ⇒ Handle → FileOffset → m ()+rseek h o = liftIO $ SIO.hSeek h RelativeSeek (fromIntegral o) -seek_ ∷ (MonadIO m) ⇒ Handle → FilePosition → m ()-seek_ h p = liftIO $ SIO.hSeek h AbsoluteSeek (fromIntegral p)+-- | Seek to an absolute position in 'Handle'.+aseek ∷ (MonadIO m) ⇒ Handle → FilePosition → m ()+aseek h p = liftIO $ SIO.hSeek h AbsoluteSeek (fromIntegral p) +-- | Get the current 'FilePosition'. tell ∷ (MonadIO m) ⇒ Handle → m FilePosition tell h = liftIO $ fromIntegral <$> SIO.hTell h -withOffset ∷ (MonadIO m, MonadMask m) ⇒ Handle → FileOffset → (Handle → m a) → m a+-- | Function to flush a 'Handle' and seek to a position.+hreturn ∷ (MonadIO m) ⇒ FilePosition → Handle → m ()+hreturn p h = (liftIO $ SIO.hFlush h) ≫ aseek h p++-- | Save the current file position, seek relative to it, perform a+-- function, and then return to the original position.+withOffset ∷ (MonadIO m, MonadMask m) ⇒+    Handle → FileOffset → (Handle → m a) → m a withOffset h o f= do     p ← tell h-    bracket_ (seek h o) (seek_ h p) (f h)+    bracket_ (rseek h o) (hreturn p h) (f h) -withPosition ∷ (MonadIO m, MonadMask m) ⇒ Handle → FilePosition → (Handle → m a) → m a+-- | Save the current file position, seek to a new position, perform a+-- function, then return to the original position.+withPosition ∷+    (MonadIO m, MonadMask m) ⇒+    Handle → FilePosition → (Handle → m a) → m a withPosition h p f = do     o ← tell h-    bracket_ (seek_ h p) (seek_ h o) (f h)+    bracket_ (aseek h p) (hreturn o h) (f h)++withCurrentPosition ∷ (MonadIO m, MonadMask m) ⇒+    Handle → (Handle → m a) → m a+withCurrentPosition h f = withOffset h 0 f  -- * Managed temporary files 

@@ -62,9 +62,9 @@  -- | Read lines of 'Text' from a 'Handle' until $EOF$ is reached. readLines  ∷ ∀ (m ∷ * → *). (MonadIO m) ⇒ Handle → SourceT m Text-readLines h = repeatedly $ ifM (liftIO $ hIsEOF h) stop (hGetLine h)+readLines h = repeatedly $ ifM (liftIO $ hIsEOF h) stop (hGetLine h ≫= yield)  -- | Write lines of 'Text' to a 'Handle' until there are no -- more. Forwards them on. writeLines ∷ ∀ (m ∷ * → *). (MonadIO m) ⇒ Handle → ProcessT m Text Text-writeLines h = repeatedly $ await ≫= \l → hPutStrLn h l ≫ return l+writeLines h = autoM (\l → hPutStrLn h l ≫ return l)

@@ -14,22 +14,21 @@ import Textual import Arbitrary() import Test.QuickCheck-import Text+import Text hiding (text) import Text.IO import IO hiding (putStrLn) import Machine import Path -newtype Line = Line Text deriving (Eq, Ord, Show)+newtype Line = Line Text deriving (Eq, Ord, Show, Printable) instance Arbitrary Line where     arbitrary = Line <$> suchThat arbitrary (allOf each (≥ ' '))-instance Printable Line where-    print (Line t) = print t  readWriteLines ∷     (Traversable f, MonadMask m, MonadIO m) ⇒     f Line → m [Line] readWriteLines lns = textTemporaryFile (absDir "/tmp") (relFile "testTemp") $ \tf → do     let h = tf ^. tfHandle-    runT_ $ supply lns (mapping $ \(Line t) → t) ⇝ writeLines h ⇝ autoM (\l → putStrLn l ≫ return l)-    runT $ readLines h ⇝ autoM (\l → putStrLn l ≫ return l) ⇝ mapping Line+    withCurrentPosition h $ \i →+        runT_ $ supply lns (mapping $ \(Line t) → t) ⇝ writeLines i+    runT $ readLines h ⇝ mapping Line

@@ -14,7 +14,7 @@ module TestTextMachine where  import Lawless-import Text+import Text hiding (text)  import Arbitrary() import Test.Framework@@ -27,9 +27,9 @@ default (Text)  prop_CheckTextMachine ∷ [Line] → Property-prop_CheckTextMachine lines = monadicIO $ do-    m ← run $ readWriteLines lines-    assert (lines == m)+prop_CheckTextMachine lns = monadicIO $ do+    m ← run $ readWriteLines lns+    assert (lns == m)  properties ∷ Test properties = $(testGroupGenerator)

@@ -1,11 +1,11 @@ name:                liblawless-version:             0.20.2+version:             0.21.0 synopsis:            Prelude based on protolude for GHC 8 and beyond. license:             GPL-3 license-file:        LICENSE author:              Evan Cofsky maintainer:          evan@theunixman.com-copyright:           © 2016 Evan Cofsky+copyright:           © 2017 Evan Cofsky category:            Prelude build-type:          Simple extra-source-files:@@ -28,7 +28,7 @@ source-repository this   type:     git   location:   git@gitlab.com:misandrist/liblawless.git-  tag: v0.20.2+  tag: v0.21.0  library   ghc-options: -Wall -Wno-redundant-constraints -Wno-type-defaults -O2@@ -37,6 +37,7 @@                   Arbitrary                   Boomerang                   ByteString+                  Environment                   Exception                   Generics                   IO@@ -92,7 +93,7 @@                 data-textual               >= 0.3.0 && < 0.4,                 dns                        >= 2.0.8 && < 2.1,                 exceptions                 >= 0.8.3 && < 0.9,-                hjsonschema                >= 1.2.0 && < 1.3,+                hjsonschema                >= 1.6.2 && < 1.7,                 lens                       >= 4.14 && < 4.16,                 machines                   >= 0.6.1 && < 0.7,                 managed             >= 1.0.5 && < 1.1,@@ -107,11 +108,11 @@                 semigroups                 >= 0.18.2 && < 0.19,                 stm                        >= 2.4.4 && < 2.5,                 stm-containers             >= 0.2.15 && < 0.3,-                QuickCheck                 >= 2.8.2 && < 2.9,+                QuickCheck                 >= 2.8 && < 2.10,                 temporary                  >= 1.2.0 && < 1.3,                 text                       >= 1.2.2 && < 1.3,                 text-icu                   >= 0.7.0 && < 0.8,-                text-icu-normalized        >= 0.3.0 && < 0.4,+                text-icu-normalized        >= 0.4.0 && < 0.5,                 text-printer               >= 0.4 && < 0.5,                 time                       >= 1.6.0 && < 1.7,                 transformers               >= 0.5.2 && < 0.6,@@ -128,6 +129,7 @@               -feager-blackholing               -rtsopts               -dynamic+              -with-rtsopts=-N   default-language:    Haskell2010   type: exitcode-stdio-1.0   hs-source-dirs: Tests@@ -139,14 +141,14 @@                 TestTime                 Paths_liblawless   build-depends:-                QuickCheck                 >= 2.8.2 && < 2.9,+                QuickCheck                 >= 2.8 && < 2.10,                 aeson < 1.0,                 base >= 4.9 && < 4.10,                 binary >= 0.7.5.0,                 bytestring,                 exceptions >= 0.8.3,                 filepath >= 1.4.0.0,-                liblawless == 0.20.2,+                liblawless,                 temporary >= 1.2.0.4,                 test-framework,                 test-framework-quickcheck2,