WIP

Author: turion

rhine-cassava/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for rhine-cassava
+
+## 0.8.1.1 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

rhine-cassava/LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2023 Manuel Bärenz
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

rhine-cassava/rhine-cassava.cabal

@@ -0,0 +1,136 @@
+cabal-version:      3.0
+-- The cabal-version field refers to the version of the .cabal specification,
+-- and can be different from the cabal-install (the tool) version and the
+-- Cabal (the library) version you are using. As such, the Cabal (the library)
+-- version used must be equal or greater than the version stated in this field.
+-- Starting from the specification version 2.2, the cabal-version field must be
+-- the first thing in the cabal file.
+
+-- Initial package description 'rhine-cassava' generated by
+-- 'cabal init'. For further documentation, see:
+--   http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name:               rhine-cassava
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary:     +-+------- breaking API changes
+--                  | | +----- non-breaking API additions
+--                  | | | +--- code changes with no API change
+version:            1.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:            MIT
+
+-- The file containing the license text.
+license-file:       LICENSE
+
+-- The package author(s).
+author:             Manuel Bärenz
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer:         [email protected]
+
+-- A copyright notice.
+-- copyright:
+category:           FRP
+build-type:         Simple
+
+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
+extra-doc-files:    CHANGELOG.md
+
+-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall
+    if flag(dev)
+        ghc-options: -Werror
+
+flag dev
+  description: Enable warnings as errors. Active on ci.
+  default: False
+  manual: True
+
+library
+    -- Import common warning flags.
+    import:           warnings
+
+    -- Modules exported by the library.
+    exposed-modules:  FRP.Rhine.Clock.Csv
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    build-depends:    base >= 4.11 && < 4.18
+                    , rhine == 1.0
+                    , transformers >= 0.5
+                    , cassava ^>= 0.5.3
+                    , bytestring ^>= 0.11.4
+                    , vector ^>= 0.12
+
+    -- Directories containing source files.
+    hs-source-dirs:   src
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+    default-extensions:
+        FlexibleInstances
+        MultiParamTypeClasses
+        NamedFieldPuns
+        TypeFamilies
+
+test-suite rhine-cassava-test
+    -- Import common warning flags.
+    import:           warnings
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- The interface type and version of the test suite.
+    type:             exitcode-stdio-1.0
+
+    -- Directories containing source files.
+    hs-source-dirs:   test
+
+    -- The entrypoint to the test suite.
+    main-is:          Main.hs
+
+    -- Test dependencies.
+    build-depends:
+        base >= 4.11 && < 4.18
+      , hspec ^>= 2.11
+      , transformers
+      , bytestring
+      , vector
+      , directory
+      , cassava
+      , rhine
+      , rhine-cassava
+
+    default-extensions:
+        Arrows
+        ImportQualifiedPost
+        OverloadedLists
+        OverloadedStrings
+        TypeApplications

rhine-cassava/src/FRP/Rhine/Clock/Csv.hs

@@ -0,0 +1,44 @@
+module FRP.Rhine.Clock.Csv (
+  CsvClock,
+  csvClock,
+)
+where
+
+-- bytestring
+import Data.ByteString
+
+-- vector
+import Data.Vector
+
+-- cassava
+import Data.Csv
+
+-- rhine
+
+import Control.Monad.Trans.Except
+import FRP.Rhine (GetClockProxy)
+import FRP.Rhine.Clock
+import FRP.Rhine.Clock.File
+
+{- | Similar to 'File', but ticks at every line of a CSV file,
+  and returns a parsed record.
+
+  Additionally to an end-of-file error, it can also return a parse error as a 'String'.
+-}
+newtype CsvClock = CsvClock (File String (Vector Record))
+
+-- | Create a 'CsvClock' from a file path.
+csvClock :: FilePath -> CsvClock
+csvClock filename =
+  CsvClock
+    File
+      { action = fmap (decode NoHeader . fromStrict) . Data.ByteString.hGetLine
+      , filename
+      }
+
+instance Clock (ExceptT (Either String FileException) IO) CsvClock where
+  type Time CsvClock = Integer
+  type Tag CsvClock = Vector Record
+  initClock (CsvClock fileClock) = initClock fileClock
+
+instance GetClockProxy CsvClock

rhine-cassava/test/Main.hs

@@ -0,0 +1,32 @@
+module Main (main) where
+
+-- bytestring
+import Data.ByteString
+import Data.ByteString qualified as ByteString
+
+-- directory
+import System.Directory (removeFile)
+
+-- hspec
+import Test.Hspec
+
+-- vector
+import Data.Vector (Vector)
+
+-- cassava
+import Data.Csv (Record)
+
+-- rhine
+import FRP.Rhine
+import FRP.Rhine.Clock.Csv
+import FRP.Rhine.Clock.File (FileException)
+
+main :: IO ()
+main = hspec $ do
+  it "Can read a file" $ do
+    let bytestring = "hi,this\nis,dog\n" :: ByteString
+        filepath = "testfile.csv"
+    ByteString.writeFile filepath bytestring
+    Right result <- runExceptT @(Either String FileException) $ (flip embed [(), ()] =<<) $ eraseClock $ tagS @@ csvClock filepath
+    removeFile filepath
+    result `shouldBe` ([Just [["hi", "this"]], Just [["is", "dog"]]] :: [Maybe (Vector Record)])

rhine/rhine.cabal

@@ -85,6 +85,7 @@ library
   exposed-modules:
     FRP.Rhine
     FRP.Rhine.Clock
+    FRP.Rhine.Clock.File
     FRP.Rhine.Clock.FixedStep
     FRP.Rhine.Clock.Periodic
     FRP.Rhine.Clock.Proxy

rhine/src/FRP/Rhine/Clock/File.hs

@@ -0,0 +1,38 @@
+module FRP.Rhine.Clock.File where
+
+-- base
+import Data.Bifunctor (first)
+import System.IO
+import System.IO.Error
+
+-- transformers
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+
+-- rhine
+import FRP.Rhine.Clock
+import FRP.Rhine.Clock.Proxy
+
+-- | A clock that opens a file and extracts data of type @a@ from it.
+data File e a = File
+  { filename :: String
+  , action :: Handle -> IO (Either e a)
+  }
+
+instance GetClockProxy (File e a)
+
+data FileException = EndOfFile
+  deriving (Show)
+
+instance Clock (ExceptT (Either e FileException) IO) (File e a) where
+  type Time (File e a) = Integer
+  type Tag (File e a) = a
+  initClock File {filename, action} = lift $ do
+    handle <- openFile filename ReadMode
+    let getLineHandle = arrM $ const $ ExceptT $ do
+          catchIOError (Data.Bifunctor.first Left <$> action handle) $ \e -> do
+            hClose handle
+            if isEOFError e
+              then return $ Left $ Right EndOfFile
+              else ioError e
+    return (count &&& getLineHandle, 0)