polysemy-fs (empty) → 0.1.0.0

raw patch · 5 files changed

+210/−0 lines, 5 filesdep +basedep +bytestringdep +path

Dependencies added: base, bytestring, path, polysemy, rio, temporary, text, unliftio-path

Files

ChangeLog.md +5/−0
LICENSE +30/−0
README.md +52/−0
polysemy-fs.cabal +41/−0
src/Polysemy/FS.hs +82/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Changelog for polysemy-fs++## v0.1.0.0++* Small filesystem effects for polysemy.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Daniel Firth (c) 2020++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 Daniel Firth 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,52 @@+# polysemy-fs++This package offers small filesystem effects for polysemy, such as:++```+data FSExist m a where+  DoesFileExist :: Path b File -> FSExist m Bool+  DoesDirExist  :: Path b Dir  -> FSExist m Bool+```++It should be noted that these are very weak semantic abstractions, as it does+not provide a way to speak to the filesystem as a whole, and therefore is+somewhat unsuitable for mocking. These effects exist primarily to give+interpreters a way to be precise in the type of filesystem operations they use,+and should be treated in the same way as `Embed IO` in that regard. However, if+you need a quick fix - then using this directly in application code is a slight+improvement over using `Embed IO` directly.++Using these as very low level compilation units allows you to inject debugging+everywhere you use a filesystem operation. For example, using [co-log-polysemy](https://hackage.haskell.org/package/co-log-polysemy) we can do this:++```+data FileExists where+  FileExists    :: Path b File -> FileExists+  FileNotExists :: Path b File -> FileExists++data DirExists where+  DirExists    :: Path b Dir -> DirExists+  DirNotExists :: Path b Dir -> DirExists++logFileExists :: Members '[FSExist, Log FileExists] r => Sem r a -> Sem r a+logFileExists = intercept \case+  DoesFileExist x -> do+    z <- doesFileExist x+    case z of+      True  -> log $ FileExists x+      False -> log $ FileNotExists x+    return z+  DoesDirExist x -> doesDirExist x++logDirExists :: Members '[FSExist, Log DirExists] r => Sem r a -> Sem r a+logDirExists = intercept \case+  DoesDirExist x  -> do+    z <- doesDirExist x+    case z of+      True  -> log $ DirExists x+      False -> log $ DirNotExists x+    return z+  DoesFileExist x -> doesFileExist x+```++For a look at a unified version of filesystem operations, check out [polysemy-fskvstore](https://hackage.haskell.org/package/fskv-store)

+ polysemy-fs.cabal view

@@ -0,0 +1,41 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           polysemy-fs+version:        0.1.0.0+synopsis:       Low level filesystem operations for polysemy.+category:       Polysemy Filesystem+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      dan.firth@homotopic.tech+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/homotopic-tech/polysemy-fs++library+  exposed-modules:+      Polysemy.FS+  other-modules:+      Paths_polysemy_fs+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring+    , path+    , polysemy+    , rio+    , temporary+    , text+    , unliftio-path+  default-language: Haskell2010

+ src/Polysemy/FS.hs view

@@ -0,0 +1,82 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds      #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs          #-}+{-# LANGUAGE LambdaCase     #-}+{-# LANGUAGE PolyKinds      #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators  #-}+module Polysemy.FS where++import Polysemy+import qualified UnliftIO.Path.Directory as U+import Data.Text (Text)+import qualified System.IO.Temp as U+import RIO+import Path+import qualified Data.ByteString as BS++data FSExist m a where+  DoesFileExist :: Path b File -> FSExist m Bool+  DoesDirExist  :: Path b Dir  -> FSExist m Bool++makeSem ''FSExist++data FSRead m a where+  ReadFileBS   :: Path b File -> FSRead m BS.ByteString+  ReadFileUtf8 :: Path b File -> FSRead m Text++makeSem ''FSRead++data FSWrite m a where+  WriteFileBS   :: Path b File -> BS.ByteString -> FSWrite m ()+  WriteFileUtf8 :: Path b File -> Text -> FSWrite m ()++makeSem ''FSWrite++data FSCopy m a where+  CopyFile :: Path b File -> Path b' File -> FSCopy m ()++makeSem ''FSCopy++data FSTemp m a where+  CreateTempDirectory :: FSTemp m (Path Abs Dir)++makeSem ''FSTemp++data FSDir m a where+  CreateDirectory :: Path b Dir -> FSDir m ()+  RemoveDirectory :: Path b Dir -> FSDir m ()++makeSem ''FSDir++runFSExist :: Member (Embed IO) r => Sem (FSExist ': r) a -> Sem r a+runFSExist = interpret \case+  DoesFileExist x -> U.doesFileExist x+  DoesDirExist x  -> U.doesDirectoryExist  x++runFSRead :: Member (Embed IO) r => Sem (FSRead ': r) a -> Sem r a+runFSRead = interpret \case+  ReadFileBS x   -> embed $ BS.readFile (toFilePath x)+  ReadFileUtf8 x -> RIO.readFileUtf8 (toFilePath x)++runFSWrite :: Member (Embed IO) r => Sem (FSWrite ': r) a -> Sem r a+runFSWrite = interpret \case+  WriteFileBS x y -> embed $ BS.writeFile (toFilePath x) y+  WriteFileUtf8 x y -> RIO.writeFileUtf8 (toFilePath x) y++runFSCopy :: Member (Embed IO) r => Sem (FSCopy ': r) a -> Sem r a+runFSCopy = interpret \case+  CopyFile x y -> U.copyFile x y++runFSDir :: Member (Embed IO) r => Sem (FSDir ': r) a -> Sem r a+runFSDir = interpret \case+  CreateDirectory x -> U.createDirectoryIfMissing True x+  RemoveDirectory x -> U.removeDirectoryRecursive x++runFSTemp :: Member (Embed IO) r => Sem (FSTemp ': r) a -> Sem r a+runFSTemp = interpret \case+  CreateTempDirectory -> do+    x <- embed U.getCanonicalTemporaryDirectory+    embed $ U.createTempDirectory x "" >>= parseAbsDir