----------------------------------------------------------------------
--
-- Module      :  uniform.TypedFile
-- Copyright   :  andrew u frank -
--
-- mapping data structures to files typed with an extension
-- write and read quasi type-checked
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

module Uniform.TypedFile
  ( module Uniform.TypedFile,
    GZip.compress,
    GZip.decompress,
    EpochTime,
  )
where

import qualified Codec.Compression.GZip as GZip
import qualified Data.ByteString.Lazy as L
import qualified Path.IO (ensureDir)
import Uniform.FileIOalgebra (Handle)
import Uniform.FileStatus (EpochTime)
import Uniform.FileStrings
import Uniform.Filenames as FN (Path)
import Uniform.Strings 
import Uniform.Error

data TypedFile5 a b = TypedFile5 {TypedFile5 a b -> Extension
tpext5 :: Extension}

rdfGraphDebug :: Bool
rdfGraphDebug = Bool
False

-- | reads or writes  a structured file with the specified parsers or writer
-- the first parameter is the type of file, it is the type of the
-- input data and the returned data
-- the second an arbitrary differentiation
-- to allow two file types with different extension and read
-- the b can be () if no differentiation is desired
class
  (FileHandles a) =>
  TypedFiles5 a b
  where
  append5 Path Abs Dir
f = [Text] -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for append5", Path Abs Dir -> Text
forall a. Show a => a -> Text
showT Path Abs Dir
f]
  read5 Path Abs Dir
f = [Text] -> Path Rel File -> TypedFile5 a b -> ErrIO a
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for read5", Path Abs Dir -> Text
forall a. Show a => a -> Text
showT Path Abs Dir
f]
  read6 Path Abs File
f = [Text] -> TypedFile5 a b -> ErrIO a
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for read6", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
f]
  append6 Path Abs File
f = [Text] -> TypedFile5 a b -> a -> ErrIO ()
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for append6", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
f]
  openHandle6 Path Abs File
f = [Text] -> TypedFile5 a b -> ErrIO Handle
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for openHandle6", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
f]
  writeHandle6 Handle
f = [Text] -> TypedFile5 a b -> a -> ErrIO ()
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for writeHandle6", Handle -> Text
forall a. Show a => a -> Text
showT Handle
f]
  closeHandle6 Path Abs File
f = [Text] -> TypedFile5 a b -> Handle -> ErrIO ()
forall a. [Text] -> a
errorT [Text
"TypedFiles - no implementation for closeHandle6", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
f]

  write5 :: FN.Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()
  -- write a file, directory is created if not exist
  -- file, if exist, is replaced
  write5 Path Abs Dir
fp Path Rel File
fn TypedFile5 a b
tp a
ct = do
    ()
dirx <- Path Abs Dir -> ErrIO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir (Path Abs Dir -> Path Abs Dir
forall a. a -> a
unPath Path Abs Dir
fp)
    Path Abs File -> TypedFile5 a b -> a -> ErrIO ()
forall a b.
TypedFiles5 a b =>
Path Abs File -> TypedFile5 a b -> a -> ErrIO ()
write6 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn) TypedFile5 a b
tp a
ct

  append5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()
  read5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> ErrIO a

  write6 :: Path Abs File -> TypedFile5 a b -> a -> ErrIO ()
  -- write a file, directory is created if not exist
  -- file, if exist, is replaced
  write6 Path Abs File
fp TypedFile5 a b
tp a
queryText = do
    --        when rdfGraphDebug $
    [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"write6", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
fp]
    --        let fn2 = fp </> addExt lpX fn (tpext tp)  -- :: LegalPathname
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 a b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 a b
tp) Path Abs File
fp
    FilePath -> ErrIO ()
forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' (Path Abs File -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path Abs File
fp) -- add everywhere?
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$
      [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
        [ Text
"sparql Turtle createDIrIfMissing' ",
          FilePath -> Text
forall a. Show a => a -> Text
showT (Path Abs File -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path Abs File
fp)
        ]
    Handle
hand <- Path Abs File -> IOMode -> ErrIO Handle
forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
fn2 IOMode
WriteMode
    --        when rdfGraphDebug $ putIOwords ["write6", showT fn2]

    Handle -> a -> ErrIO ()
forall t. FileHandles t => Handle -> t -> ErrIO ()
write2handle Handle
hand a
queryText -- changed for Text not []
    Handle -> ErrIO ()
closeFile2 Handle
hand

  openHandle6 :: Path Abs File -> TypedFile5 a b -> ErrIO Handle

  -- | create the file and open the handle
  -- should attache ".tmp" to extension and when closing
  -- rename to correct filename - > transaction completed
  writeHandle6 :: Handle -> TypedFile5 a b -> a -> ErrIO ()

  closeHandle6 :: Path Abs File -> TypedFile5 a b -> Handle -> ErrIO ()

  -- | close the handle - with transaction
  append6 :: Path Abs File -> TypedFile5 a b -> a -> ErrIO ()

  -- append to the file, with the same methods as in write6
  read6 :: Path Abs File -> TypedFile5 a b -> ErrIO a

  exist6 :: Path Abs File -> TypedFile5 a b -> ErrIO Bool
  -- ^ check whether file exist
  exist6 Path Abs File
fp TypedFile5 a b
tp = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 a b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 a b
tp) Path Abs File
fp :: Path Abs File
    Path Abs File -> ErrIO Bool
forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' Path Abs File
fn2

  modificationTime6 :: Path Abs File -> TypedFile5 a b -> ErrIO EpochTime
  modificationTime6 Path Abs File
fp TypedFile5 a b
tp = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 a b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 a b
tp) Path Abs File
fp :: Path Abs File
    EpochTime
t :: EpochTime <- Path Abs File -> ErrIO EpochTime
forall fp. FileOps fp => fp -> ErrIO EpochTime
getFileModificationTime Path Abs File
fn2
    EpochTime -> ErrIO EpochTime
forall (m :: * -> *) a. Monad m => a -> m a
return EpochTime
t

  isTyped :: Path Abs File -> TypedFile5 a b -> Bool
  -- ^ check if a given file is of the right type (extenions, not mime type)
  isTyped Path Abs File
fp TypedFile5 a b
tp = Path Abs File -> ExtensionType (Path Abs File)
forall fp. Extensions fp => fp -> ExtensionType fp
getExtension Path Abs File
fp Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
== TypedFile5 a b -> Extension
forall a b. TypedFiles5 a b => TypedFile5 a b -> Extension
typedExtension TypedFile5 a b
tp

  typedExtension :: TypedFile5 a b -> Extension
  -- ^ get the extension back
  typedExtension TypedFile5 a b
tp = TypedFile5 a b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 a b
tp

  makeTyped :: Extension -> TypedFile5 a b
  -- make a typed file type, needs type specification!
  makeTyped Extension
ext = TypedFile5 :: forall a b. Extension -> TypedFile5 a b
TypedFile5 {tpext5 :: Extension
tpext5 = Extension
ext}

instance TypedFiles5 Text b where
  -- file contains a list of lines (text)
  write5 :: Path Abs Dir
-> Path Rel File -> TypedFile5 Text b -> Text -> ErrIO ()
write5 Path Abs Dir
fp Path Rel File
fn TypedFile5 Text b
tp Text
ct = do
    ()
dirx <- Path Abs Dir -> ErrIO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir (Path Abs Dir -> Path Abs Dir
forall a. a -> a
unPath Path Abs Dir
fp)
    let fn2 :: Path Rel File
fn2 = Path Rel File
fn Path Rel File -> ExtensionType (Path Rel File) -> Path Rel File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp -- :: Path ar File
    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
writeFile2 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn2) Text
ct

  --      writeFile2 (fp </> (fn <.> (tpext tp) )) . unlines'
  append5 :: Path Abs Dir
-> Path Rel File -> TypedFile5 Text b -> Text -> ErrIO ()
append5 Path Abs Dir
fp Path Rel File
fn TypedFile5 Text b
tp Text
ct = do
    ()
dirx <- Path Abs Dir -> ErrIO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir (Path Abs Dir -> Path Abs Dir
forall a. a -> a
unPath Path Abs Dir
fp)
    let fn2 :: Path Rel File
fn2 = Path Rel File
fn Path Rel File -> ExtensionType (Path Rel File) -> Path Rel File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp -- :: Path ar File
    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
appendFile2 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn2) Text
ct
  read5 :: Path Abs Dir -> Path Rel File -> TypedFile5 Text b -> ErrIO Text
read5 Path Abs Dir
fp Path Rel File
fn TypedFile5 Text b
tp = do
    let fn2 :: Path Rel File
fn2 = Path Rel File
fn Path Rel File -> ExtensionType (Path Rel File) -> Path Rel File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp
    Path Abs File -> ErrIO Text
forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 (Path Abs File -> ErrIO Text) -> Path Abs File -> ErrIO Text
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn2

  append6 :: Path Abs File -> TypedFile5 Text b -> Text -> ErrIO ()
append6 Path Abs File
fn TypedFile5 Text b
tp Text
ct = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp) Path Abs File
fn
    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
appendFile2 Path Abs File
fn2 Text
ct
  write6 :: Path Abs File -> TypedFile5 Text b -> Text -> ErrIO ()
write6 Path Abs File
fn TypedFile5 Text b
tp Text
ct = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp) Path Abs File
fn
    Handle
hand <- Path Abs File -> IOMode -> ErrIO Handle
forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
fn2 IOMode
WriteMode

    Handle -> Text -> ErrIO ()
forall t. FileHandles t => Handle -> t -> ErrIO ()
write2handle Handle
hand Text
ct

    Handle -> ErrIO ()
closeFile2 Handle
hand

  exist6 :: Path Abs File -> TypedFile5 Text b -> ErrIO Bool
exist6 Path Abs File
fn TypedFile5 Text b
tp = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp) Path Abs File
fn
    Path Abs File -> ErrIO Bool
forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' Path Abs File
fn2

  read6 :: Path Abs File -> TypedFile5 Text b -> ErrIO Text
read6 Path Abs File
fn TypedFile5 Text b
tp = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp) Path Abs File
fn
    Path Abs File -> ErrIO Text
forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 Path Abs File
fn2

instance TypedFiles5 [Text] b where
  -- file contains a list of lines (text)
  --    mkTypedFile5  = TypedFile5 { tpext5 = Extension "txt"}
  write5 :: Path Abs Dir
-> Path Rel File -> TypedFile5 [Text] b -> [Text] -> ErrIO ()
write5 Path Abs Dir
fp Path Rel File
fn TypedFile5 [Text] b
tp [Text]
ct = do
    ()
dirx <- Path Abs Dir -> ErrIO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir (Path Abs Dir -> Path Abs Dir
forall a. a -> a
unPath Path Abs Dir
fp)
    let fn2 :: Path Rel File
fn2 = Path Rel File
fn Path Rel File -> ExtensionType (Path Rel File) -> Path Rel File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp -- :: Path ar File
    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
writeFile2 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn2) ([Text] -> Text
forall a. CharChains a => [a] -> a
unlines' [Text]
ct)

  append5 :: Path Abs Dir
-> Path Rel File -> TypedFile5 [Text] b -> [Text] -> ErrIO ()
append5 Path Abs Dir
fp Path Rel File
fn TypedFile5 [Text] b
tp [Text]
ct = do
    ()
dirx <- Path Abs Dir -> ErrIO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir (Path Abs Dir -> Path Abs Dir
forall a. a -> a
unPath Path Abs Dir
fp)
    let fn2 :: Path Rel File
fn2 = Path Rel File
fn Path Rel File -> ExtensionType (Path Rel File) -> Path Rel File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp -- :: Path ar File
    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
appendFile2 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn2) ([Text] -> Text
forall a. CharChains a => [a] -> a
unlines' [Text]
ct)
  read5 :: Path Abs Dir
-> Path Rel File -> TypedFile5 [Text] b -> ErrIO [Text]
read5 Path Abs Dir
fp Path Rel File
fn TypedFile5 [Text] b
tp = do
    let fn2 :: Path Rel File
fn2 = Path Rel File
fn Path Rel File -> ExtensionType (Path Rel File) -> Path Rel File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp
    (Text -> [Text]) -> ErrIO Text -> ErrIO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Text]
forall a. CharChains a => a -> [a]
lines' (ErrIO Text -> ErrIO [Text])
-> (Path Abs File -> ErrIO Text) -> Path Abs File -> ErrIO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> ErrIO Text
forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 (Path Abs File -> ErrIO [Text]) -> Path Abs File -> ErrIO [Text]
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn2

  append6 :: Path Abs File -> TypedFile5 [Text] b -> [Text] -> ErrIO ()
append6 Path Abs File
fn TypedFile5 [Text] b
tp [Text]
ct = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp) Path Abs File
fn
    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
appendFile2 Path Abs File
fn2 ([Text] -> Text
forall a. CharChains a => [a] -> a
unlines' [Text]
ct)
  write6 :: Path Abs File -> TypedFile5 [Text] b -> [Text] -> ErrIO ()
write6 Path Abs File
fn TypedFile5 [Text] b
tp [Text]
ct = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp) Path Abs File
fn
    Handle
hand <- Path Abs File -> IOMode -> ErrIO Handle
forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
fn2 IOMode
WriteMode

    Handle -> Text -> ErrIO ()
forall t. FileHandles t => Handle -> t -> ErrIO ()
write2handle Handle
hand ([Text] -> Text
forall a. CharChains a => [a] -> a
unlines' [Text]
ct)

    Handle -> ErrIO ()
closeFile2 Handle
hand

  exist6 :: Path Abs File -> TypedFile5 [Text] b -> ErrIO Bool
exist6 Path Abs File
fn TypedFile5 [Text] b
tp = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp) Path Abs File
fn
    Path Abs File -> ErrIO Bool
forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' Path Abs File
fn2

  read6 :: Path Abs File -> TypedFile5 [Text] b -> ErrIO [Text]
read6 Path Abs File
fn TypedFile5 [Text] b
tp = do
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 [Text] b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 [Text] b
tp) Path Abs File
fn
    (Text -> [Text]) -> ErrIO Text -> ErrIO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Text]
forall a. CharChains a => a -> [a]
lines' (ErrIO Text -> ErrIO [Text])
-> (Path Abs File -> ErrIO Text) -> Path Abs File -> ErrIO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> ErrIO Text
forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 (Path Abs File -> ErrIO [Text]) -> Path Abs File -> ErrIO [Text]
forall a b. (a -> b) -> a -> b
$ Path Abs File
fn2

data GZip

-- | files with full triples stored as zip
instance TypedFiles5 LazyByteString GZip where
  append6 :: Path Abs File
-> TypedFile5 LazyByteString GZip -> LazyByteString -> ErrIO ()
append6 Path Abs File
fp TypedFile5 LazyByteString GZip
tp LazyByteString
jsonld = do
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"triples append6", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
fp]
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 LazyByteString GZip -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 LazyByteString GZip
tp) Path Abs File
fp

    Path Abs File -> LazyByteString -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
appendFile2 Path Abs File
fn2 (LazyByteString -> LazyByteString
GZip.compress LazyByteString
jsonld)

  openHandle6 :: Path Abs File -> TypedFile5 LazyByteString GZip -> ErrIO Handle
openHandle6 Path Abs File
fp TypedFile5 LazyByteString GZip
tp = do
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"openHandle6 jsonld"]
    let ext :: FilePath
ext = Extension -> FilePath
unExtension (TypedFile5 LazyByteString GZip -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 LazyByteString GZip
tp)
    let tmpext :: Extension
tmpext = FilePath -> Extension
Extension (FilePath
ext FilePath -> ExtensionType FilePath -> FilePath
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> ExtensionType FilePath
"tmp")
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension ExtensionType (Path Abs File)
Extension
tmpext Path Abs File
fp
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"openHandle6 jsonld", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
fn2]

    FilePath -> ErrIO ()
forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' (Path Abs File -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path Abs File
fn2) -- add everywhere?
    Handle
hand <- Path Abs File -> IOMode -> ErrIO Handle
forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
fn2 IOMode
WriteMode
    -- should create or truncate the file, but not when the dir not exist
    --https://hackage.haskell.org/package/base-4.10.0.0/docs/System-IO.html#g:5
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"openHandle6 jsonld", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
fn2]
    Handle -> ErrIO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
hand

  closeHandle6 :: Path Abs File
-> TypedFile5 LazyByteString GZip -> Handle -> ErrIO ()
closeHandle6 Path Abs File
fp TypedFile5 LazyByteString GZip
tp Handle
hand = do
    --        when rdfGraphDebug $
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"closeHandle6 jsonld"]
    let ext :: FilePath
ext = Extension -> FilePath
unExtension (TypedFile5 LazyByteString GZip -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 LazyByteString GZip
tp)
    let tmpext :: Extension
tmpext = FilePath -> Extension
Extension (FilePath
ext FilePath -> ExtensionType FilePath -> FilePath
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> ExtensionType FilePath
"tmp")
    Handle -> ErrIO ()
closeFile2 Handle
hand
    let fn2 :: Path Abs File
fn2 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension ExtensionType (Path Abs File)
Extension
tmpext Path Abs File
fp
    let fn1 :: Path Abs File
fn1 = ExtensionType (Path Abs File) -> Path Abs File -> Path Abs File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (TypedFile5 LazyByteString GZip -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 LazyByteString GZip
tp) Path Abs File
fp
    Path Abs File -> Path Abs File -> ErrIO ()
forall fp. FileOps fp => fp -> fp -> ErrIO ()
renameOneFile Path Abs File
fn2 Path Abs File
fn1
    Bool -> ErrIO () -> ErrIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rdfGraphDebug (ErrIO () -> ErrIO ()) -> ErrIO () -> ErrIO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrIO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"closeHandle6 jsonld", Path Abs File -> Text
forall a. Show a => a -> Text
showT Path Abs File
fn2]
    () -> ErrIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  writeHandle6 :: Handle
-> TypedFile5 LazyByteString GZip -> LazyByteString -> ErrIO ()
writeHandle6 Handle
hand TypedFile5 LazyByteString GZip
tp LazyByteString
jsonld = do
    ()
r <- Handle -> LazyByteString -> ErrIO ()
forall t. FileHandles t => Handle -> t -> ErrIO ()
write2handle Handle
hand (LazyByteString -> LazyByteString
GZip.compress LazyByteString
jsonld)
    () -> ErrIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
r

  read6 :: Path Abs File
-> TypedFile5 LazyByteString GZip -> ErrIO LazyByteString
read6 Path Abs File
fp TypedFile5 LazyByteString GZip
tp = FilePath -> ErrIO LazyByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"read for jsonld is not easy and not required"

-- | the a is the base type
-- which is written on file, b is the type for input and output
class FileHandles a => TypedFiles7 a b where
  wrap7 :: a -> b
  unwrap7 :: b -> a

class FileHandles a => TypedFiles7a a b where
  -- | the 7 have two arguments for path and file
  read7 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> ErrIO b

  write7 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> b -> ErrIO ()

  -- | the 8 versions have a single argument for path and file
  read8 :: Path Abs File -> TypedFile5 a b -> ErrIO b

  write8 :: Path Abs File -> TypedFile5 a b -> b -> ErrIO ()
  -- ^ the createDir if missingis implied in the write

instance (TypedFiles7 Text b) => TypedFiles7a Text b where
  -- an instance for all what has text or bytestring  as underlying rep
  write7 :: Path Abs Dir -> Path Rel File -> TypedFile5 Text b -> b -> ErrIO ()
write7 Path Abs Dir
fp Path Rel File
fn TypedFile5 Text b
tp b
ct = do
    Path Abs File -> TypedFile5 Text b -> b -> ErrIO ()
forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ErrIO ()
write8 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn) TypedFile5 Text b
tp b
ct

  read7 :: Path Abs Dir -> Path Rel File -> TypedFile5 Text b -> ErrIO b
read7 Path Abs Dir
fp Path Rel File
fn TypedFile5 Text b
tp = do
    Path Abs File -> TypedFile5 Text b -> ErrIO b
forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn) TypedFile5 Text b
tp

  write8 :: Path Abs File -> TypedFile5 Text b -> b -> ErrIO ()
write8 Path Abs File
fp TypedFile5 Text b
tp b
ct = do
    let fn2 :: Path Abs File
fn2 = Path Abs File
fp Path Abs File -> ExtensionType (Path Abs File) -> Path Abs File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp -- :: Path ar File
    let parent :: FilePath
parent = Path Abs File -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path Abs File
fn2
    FilePath -> ErrIO ()
forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' FilePath
parent

    Path Abs File -> Text -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
writeFile2 Path Abs File
fn2 (b -> Text
forall a b. TypedFiles7 a b => b -> a
unwrap7 b
ct :: Text)

  read8 :: Path Abs File -> TypedFile5 Text b -> ErrIO b
read8 Path Abs File
fp TypedFile5 Text b
tp = do
    let fp2 :: Path Abs File
fp2 = Path Abs File
fp Path Abs File -> ExtensionType (Path Abs File) -> Path Abs File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 Text b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 Text b
tp
    Text
ares :: Text <- Path Abs File -> ErrIO Text
forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 Path Abs File
fp2
    b -> ErrIO b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ErrIO b) -> (Text -> b) -> Text -> ErrIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> b
forall a b. TypedFiles7 a b => a -> b
wrap7 (Text -> ErrIO b) -> Text -> ErrIO b
forall a b. (a -> b) -> a -> b
$ Text
ares

instance (TypedFiles7 L.ByteString b) => TypedFiles7a L.ByteString b where
  -- an instance for all what has text or bytestring  as underlying rep
  write7 :: Path Abs Dir
-> Path Rel File -> TypedFile5 LazyByteString b -> b -> ErrIO ()
write7 Path Abs Dir
fp Path Rel File
fn TypedFile5 LazyByteString b
tp b
ct = do
    Path Abs File -> TypedFile5 LazyByteString b -> b -> ErrIO ()
forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ErrIO ()
write8 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn) TypedFile5 LazyByteString b
tp b
ct

  read7 :: Path Abs Dir
-> Path Rel File -> TypedFile5 LazyByteString b -> ErrIO b
read7 Path Abs Dir
fp Path Rel File
fn TypedFile5 LazyByteString b
tp = do
    Path Abs File -> TypedFile5 LazyByteString b -> ErrIO b
forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 (Path Abs Dir
fp Path Abs Dir
-> Path Rel File -> FileResultT (Path Abs Dir) (Path Rel File)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn) TypedFile5 LazyByteString b
tp

  write8 :: Path Abs File -> TypedFile5 LazyByteString b -> b -> ErrIO ()
write8 Path Abs File
fp TypedFile5 LazyByteString b
tp b
ct = do
    let fn2 :: Path Abs File
fn2 = Path Abs File
fp Path Abs File -> ExtensionType (Path Abs File) -> Path Abs File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 LazyByteString b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 LazyByteString b
tp -- :: Path ar File
    let parent :: FilePath
parent = Path Abs File -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path Abs File
fn2
    FilePath -> ErrIO ()
forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' FilePath
parent
    Path Abs File -> LazyByteString -> ErrIO ()
forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
writeFile2 Path Abs File
fn2 (b -> LazyByteString
forall a b. TypedFiles7 a b => b -> a
unwrap7 b
ct :: L.ByteString)

  read8 :: Path Abs File -> TypedFile5 LazyByteString b -> ErrIO b
read8 Path Abs File
fp TypedFile5 LazyByteString b
tp = do
    let fp2 :: Path Abs File
fp2 = Path Abs File
fp Path Abs File -> ExtensionType (Path Abs File) -> Path Abs File
forall fp. Extensions fp => fp -> ExtensionType fp -> fp
<.> TypedFile5 LazyByteString b -> Extension
forall a b. TypedFile5 a b -> Extension
tpext5 TypedFile5 LazyByteString b
tp
    LazyByteString
ares :: L.ByteString <- Path Abs File -> ErrIO LazyByteString
forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 Path Abs File
fp2
    b -> ErrIO b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ErrIO b)
-> (LazyByteString -> b) -> LazyByteString -> ErrIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> b
forall a b. TypedFiles7 a b => a -> b
wrap7 (LazyByteString -> ErrIO b) -> LazyByteString -> ErrIO b
forall a b. (a -> b) -> a -> b
$ LazyByteString
ares