directory-layout 0.6.1.1 → 0.7.0.0

raw patch · 7 files changed

+130/−56 lines, 7 filesdep +temporarydep −Unixutilsdep −bifunctorsPVP ok

version bump matches the API change (PVP)

Dependencies added: temporary

Dependencies removed: Unixutils, bifunctors

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• directory-layout.cabal +5/−5
• src/System/Directory/Layout/Internal.hs +7/−0
• src/System/Directory/Layout/Interpreter.hs +54/−40
• test/SpecHelper.hs +2/−2
• test/System/Directory/Layout/InterpreterSpec.hs +44/−4
• test/System/Directory/LayoutSpec.hs +4/−5

@@ -1,3 +1,17 @@+0.7.0.0+=======++  * Renamed `spec` interpreter to `examples` to make it `hspec-discover`-compatible++  * Switch API to `Either` from a `Validation`-like thingie++0.6.2.0+=======++  * Added `remake`++  * Generalized `fromErrors`+ 0.6.1.1 ======= 

@@ -1,5 +1,5 @@ name:                directory-layout-version:             0.6.1.1+version:             0.7.0.0 synopsis:            Directory layout DSL description:   Making, fitting, printing directory layouts@@ -21,14 +21,13 @@ source-repository this   type:     git   location: https://github.com/supki/directory-layout-  tag:      0.6.1.0+  tag:      0.7.0.0  library   default-language:     Haskell2010   build-depends:       base                 >= 4.6   && < 5-    , bifunctors           >= 4     , bytestring     , directory     , filepath@@ -73,7 +72,6 @@     exitcode-stdio-1.0   build-depends:       base >= 4.6-    , bifunctors     , bytestring     , directory     , filepath@@ -82,11 +80,11 @@     , lens >= 4     , semigroups     , template-haskell+    , temporary >= 1.2.0.3     , text     , transformers     , unix     , unordered-containers-    , Unixutils   hs-source-dirs:     src     test@@ -97,3 +95,5 @@     System.Directory.LayoutSpec     System.Directory.Layout.InternalSpec     System.Directory.Layout.InterpreterSpec+  cpp-options:+    -DTEST

@@ -14,13 +14,17 @@ import           Control.Lens import           Control.Monad.Free import           Data.ByteString (ByteString)+#if __GLASGOW_HASKELL__ >= 708 import qualified Data.ByteString as ByteString+#endif import           Data.Data (Data, Typeable) import           Data.Foldable (Foldable) import qualified Data.HashMap.Strict as HashMap import           Data.Semigroup (Semigroup(..)) import           Data.String (IsString(..))+#if __GLASGOW_HASKELL__ >= 708 import           Data.Word (Word8)+#endif import           Data.Text (Text) #if __GLASGOW_HASKELL__ >= 708 import           GHC.Exts (IsList(..))@@ -28,6 +32,9 @@ import           GHC.Generics (Generic) import           System.FilePath ((</>)) import qualified System.Posix as Posix++-- $setup+-- >>> import qualified Data.ByteString as ByteString  -- | Directory layout description newtype Layout a = L { unL :: Free F a }

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}@@ -5,32 +6,33 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} -- | A bunch of 'Layout' description interpreters module System.Directory.Layout.Interpreter   ( pretty-  , spec-  , Validation(..)+  , examples   , fromErrors   , fit   , FitError(..)   , FitContentsError(..)   , make+  , remake   , MakeError(..)+#ifdef TEST+  , (\/)(..)+#endif   ) where  import           Control.Applicative import           Control.Exception (Exception(..), SomeException(..), throwIO, try) import           Control.Monad import           Control.Monad.Free-import           Data.Bifoldable (Bifoldable(..))-import           Data.Bifunctor (Bifunctor(..))-import           Data.Bitraversable (Bitraversable(..)) import           Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as ByteStringLazy import           Data.Data (Data, Typeable)-import           Data.Foldable (Foldable, sequenceA_, for_)+import           Data.Foldable (Foldable, sequenceA_, for_, toList) import           Data.Functor.Compose (Compose(..)) import           Data.List.NonEmpty (NonEmpty(..)) import           Data.Maybe (fromMaybe)@@ -41,7 +43,7 @@ import           Data.Typeable (cast) import           GHC.Generics (Generic) import           Numeric (showOct)-import           System.Directory (createDirectoryIfMissing)+import           System.Directory (createDirectory, createDirectoryIfMissing, removeDirectoryRecursive) import           System.FilePath (combine) import           System.IO.Error (IOErrorType, ioeGetErrorType, ioeGetFileName, ioeGetLocation) import qualified System.Posix as Posix@@ -74,23 +76,23 @@ prettyC Nothing = "anything"  -- | Interpret the directory layout as a 'Spec'-spec :: FilePath -> Layout a -> Spec-spec p = go p . unL where+examples :: FilePath -> Layout a -> Spec+examples p = go p . unL where   go root (Free f@(F _ _ _ m)) = do-    specF root f+    examplesF root f     go root m   go root (Free f@(SL _ _ _ _ m)) = do-    specF root f+    examplesF root f     go root m   go root (Free f@(D (combine root -> fullpath) is _ m)) = do-    specF root f+    examplesF root f     context (printf "directory ‘%s’" fullpath) (go fullpath is)     go root m   go _ (Free E) = return ()   go _ (Pure _) = return () -specF :: FilePath -> F a -> Spec-specF root = go where+examplesF :: FilePath -> F a -> Spec+examplesF root = go where   go f@(F name cs _ _) = it (printf "has a %s file ‘%s’" (examplesC cs) name) (fitIO root f)   go f@(SL name s _ _ _) = it (printf "has a symlink ‘%s’ pointing to ‘%s’" name s) (fitIO root f)   go f@(D (combine root -> fullpath) _ _ _) = it (printf "has a subdirectory ‘%s’" fullpath) (fitIO root f)@@ -104,7 +106,7 @@  validate   :: Exception e-  => (forall a. FilePath -> F a -> IO ()) -> FilePath -> Layout b -> IO (Validation (NonEmpty e) ())+  => (forall a. FilePath -> F a -> IO ()) -> FilePath -> Layout b -> IO (NonEmpty e \/ ()) validate g p = getCompose . go p . unL where   go root (Free f@(F _ _ _ m)) =     sequenceA_ [Compose (validateF root f), go root m]@@ -115,11 +117,14 @@   go _ (Free E) = pure ()   go _ (Pure _) = pure () -  validateF root l = first pure . fromEither <$> try (g root l)+  validateF root = validateIO . g root +validateIO :: Exception e => IO a -> IO (NonEmpty e \/ a)+validateIO io = either (Error . pure) Result <$> try io+ -- | Check the real directory layout fits the description-fit :: FilePath -> Layout a -> IO (Validation (NonEmpty FitError) ())-fit = validate fitIO+fit :: FilePath -> Layout a -> IO (Either (NonEmpty FitError) ())+fit p = fmap toEither . validate fitIO p  fitIO :: FilePath -> F a -> IO () fitIO root = go where@@ -254,9 +259,15 @@     | otherwise = cast e  -- | Make the real directory layout from the description-make :: FilePath -> Layout a -> IO (Validation (NonEmpty MakeError) ())-make = validate makeIO+make :: FilePath -> Layout a -> IO (Either (NonEmpty MakeError) ())+make p = fmap toEither . validate makeIO p +-- | Make the real directory layout from the description removing any previous contents+remake :: FilePath -> Layout a -> IO (Either (NonEmpty MakeError) ())+remake p l = fmap toEither . getCompose $+  Compose (validateIO (removeDirectoryRecursive p *> createDirectory p)) *>+  Compose (fmap fromEither (make p l))+ makeIO :: FilePath -> F a -> IO () makeIO root = go where   go (F (combine root -> fullpath) cs a _) = do@@ -316,38 +327,41 @@ getGroupname = fmap Posix.groupName . Posix.getGroupEntryForID  -- | This type is isomorphic to 'Either' but its 'Applicative' instance accumulates errors-data Validation e a = Error e | Result a+data e \/ a = Error e | Result a   deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Typeable, Data, Generic) -instance Bifunctor Validation where-  bimap f _ (Error a) = Error (f a)-  bimap _ g (Result a) = Result (g a)--instance Bifoldable Validation where-  bifoldMap f _ (Error a) = f a-  bifoldMap _ g (Result a) = g a--instance Bitraversable Validation where-  bitraverse f _ (Error a) = Error <$> f a-  bitraverse _ g (Result a) = Result <$> g a--instance Semigroup e => Applicative (Validation e) where+instance Semigroup e => Applicative ((\/) e) where   pure = Result   Error f  <*> Error x  = Error (f <> x)   Error f  <*> _        = Error f   _        <*> Error x  = Error x   Result f <*> Result x = Result (f x) -fromEither :: Either e a -> Validation e a+fromEither :: Either e a -> e \/ a fromEither = either Error Result +toEither :: e \/ a -> Either e a+toEither = validation Left Right++validation :: (e -> t) -> (a -> t) -> e \/ a -> t+validation f _ (Error e)  = f e+validation _ g (Result a) = g a+ -- | Construct 'Validation' value from the list of errors -- -- >>> fromErrors []--- Result ()+-- Right () --+-- >>> fromErrors Nothing+-- Right ()+-- -- >>> fromErrors "hello"--- Error ('h' :| "ello")-fromErrors :: [e] -> Validation (NonEmpty e) ()-fromErrors [] = Result ()-fromErrors (x : xs) = Error (x :| xs)+-- Left ('h' :| "ello")+--+-- >>> fromErrors (Just "hello")+-- Left ("hello" :| [])+fromErrors :: Foldable t => t e -> Either (NonEmpty e) ()+fromErrors = go . toList+ where+  go [] = Right ()+  go (x : xs) = Left (x :| xs)

@@ -1,6 +1,6 @@ module SpecHelper where -import System.Unix.Directory (withTemporaryDirectory)+import System.IO.Temp (withSystemTempDirectory)  temporary :: (FilePath -> IO a) -> IO a-temporary = withTemporaryDirectory "directory-layout-XXXXXX"+temporary = withSystemTempDirectory "directory-layout-XXXXXX"

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeOperators #-} module System.Directory.Layout.InterpreterSpec   ( spec   ) where@@ -9,21 +10,22 @@ import qualified Data.ByteString as ByteString import           Data.Foldable (traverse_) import           Data.List.NonEmpty (NonEmpty)-import           System.Directory (createDirectoryIfMissing)+import qualified Data.List.NonEmpty as NonEmpty+import           System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) import           System.FilePath ((</>)) import           System.IO.Error (doesNotExistErrorType, permissionErrorType) import qualified System.Posix as Posix import           Test.Hspec  import           SpecHelper-import           System.Directory.Layout hiding (spec)+import           System.Directory.Layout   spec :: Spec spec = do   describe "Validation" $     it "combines failures with the Semigroup instance's (<>)" $-      traverse_ tonel ([1, 2, 3, 4] :: [Int]) `shouldBe` fromErrors [1,2,3,4]+      traverse_ tonel ([1, 2, 3, 4] :: [Int]) `shouldBe` Error (NonEmpty.fromList [1,2,3,4])    describe "fit" $ do     it "tests regular file existence" $ do@@ -212,6 +214,16 @@         fit p (l & exists .~ True) `shouldReturn`           fromErrors [] +    it "does not throw exceptions if root directory does not exist" $+      temporary $ \p -> do+        removeDirectoryRecursive p+        r <- fit p $+          file "foo"+            & contents ?~ text "bar"+        r `shouldBe` fromErrors+          [ FitIOException (p </> "foo") doesNotExistErrorType+          ]+   describe "make" $ do     -- examples use 'fit' because if the above spec passes then     -- we can be reasonably sure 'fit' works as expected@@ -410,7 +422,35 @@               (ByteString.pack [98, 121, 101])           ] -tonel :: a -> Validation (NonEmpty a) b+    it "does not throw exceptions if root directory does not exist" $+      temporary $ \p -> do+        removeDirectoryRecursive p+        r <- make p $+          file "foo"+            & contents ?~ text "bar"+        r `shouldBe` fromErrors [MakeIOException (p </> "foo") doesNotExistErrorType]++  describe "remake" $ do+    it "does not throw exceptions if root directory does not exist, but it checks its existence" $+      temporary $ \p -> do+        removeDirectoryRecursive p+        r <- remake p $+          file "foo"+            & contents ?~ text "bar"+        r `shouldBe` fromErrors+          [ MakeIOException p doesNotExistErrorType+          , MakeIOException (p </> "foo") doesNotExistErrorType+          ]++    it "does not remove symlink sources" $+      temporary $ \p -> do+        temporary $ \p' -> do+          make p' (file "quux" & contents ?~ "symlink source") `shouldReturn` fromErrors []+          make p (symlink "qux" (p' </> "quux")) `shouldReturn` fromErrors []+          remake p (file "foo" & contents ?~ text "bar") `shouldReturn` fromErrors []+          fit p' (file "quux" & contents ?~ "symlink source") `shouldReturn` fromErrors []++tonel :: a -> NonEmpty a \/ b tonel = Error . pure  makefit :: Layout a -> IO ()

@@ -4,17 +4,16 @@   ( spec   ) where -import           Control.Lens-import           Test.Hspec+import Control.Lens+import Test.Hspec -import           System.Directory.Layout hiding (spec)-import qualified System.Directory.Layout.Interpreter as L+import System.Directory.Layout   spec :: Spec spec = do   describe "directory-layout project structure" $ do-    rel L.spec project+    rel examples project  project :: Layout () project = do