{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module File where

import qualified Data.Text as T
import Data.Text.IO as T
import OurPrelude
import Polysemy.Input
import Polysemy.Output

data File m a where
  Read :: FilePath -> File m Text
  Write :: FilePath -> Text -> File m ()

makeSem ''File

runIO ::
  Member (Embed IO) r =>
  Sem (File ': r) a ->
  Sem r a
runIO :: Sem (File : r) a -> Sem r a
runIO =
  (forall (rInitial :: EffectRow) x.
 File (Sem rInitial) x -> Sem r x)
-> Sem (File : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  File (Sem rInitial) x -> Sem r x)
 -> Sem (File : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    File (Sem rInitial) x -> Sem r x)
-> Sem (File : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
    Read file -> IO Text -> Sem r Text
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Text -> Sem r Text) -> IO Text -> Sem r Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
T.readFile FilePath
file
    Write file contents -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
file Text
contents

runPure ::
  [Text] ->
  Sem (File ': r) a ->
  Sem r ([Text], a)
runPure :: [Text] -> Sem (File : r) a -> Sem r ([Text], a)
runPure [Text]
contentList =
  (Text -> [Text]) -> Sem (Output Text : r) a -> Sem r ([Text], a)
forall o m (r :: EffectRow) a.
Monoid m =>
(o -> m) -> Sem (Output o : r) a -> Sem r (m, a)
runOutputMonoid Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Sem (Output Text : r) a -> Sem r ([Text], a))
-> (Sem (File : r) a -> Sem (Output Text : r) a)
-> Sem (File : r) a
-> Sem r ([Text], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text]
-> Sem (Input (Maybe Text) : Output Text : r) a
-> Sem (Output Text : r) a
forall i (r :: EffectRow) a.
[i] -> Sem (Input (Maybe i) : r) a -> Sem r a
runInputList [Text]
contentList
    (Sem (Input (Maybe Text) : Output Text : r) a
 -> Sem (Output Text : r) a)
-> (Sem (File : r) a
    -> Sem (Input (Maybe Text) : Output Text : r) a)
-> Sem (File : r) a
-> Sem (Output Text : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: EffectRow) x.
 File (Sem rInitial) x
 -> Sem (Input (Maybe Text) : Output Text : r) x)
-> Sem (File : r) a -> Sem (Input (Maybe Text) : Output Text : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e1 "reinterpret2" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2 \case
      Read _file -> x -> (x -> x) -> Maybe x -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe x
"" x -> x
forall a. a -> a
id (Maybe x -> x)
-> Sem (Input (Maybe Text) : Output Text : r) (Maybe x)
-> Sem (Input (Maybe Text) : Output Text : r) x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Input (Maybe Text) : Output Text : r) (Maybe x)
forall i (r :: EffectRow). MemberWithError (Input i) r => Sem r i
input
      Write _file contents -> Text -> Sem (Input (Maybe Text) : Output Text : r) ()
forall o (r :: EffectRow).
MemberWithError (Output o) r =>
o -> Sem r ()
output Text
contents

replace ::
  Member File r =>
  Text ->
  Text ->
  FilePath ->
  Sem r Bool
replace :: Text -> Text -> FilePath -> Sem r Bool
replace Text
find Text
replacement FilePath
file = do
  Text
contents <- FilePath -> Sem r Text
forall (r :: EffectRow).
MemberWithError File r =>
FilePath -> Sem r Text
File.read FilePath
file
  let newContents :: Text
newContents = Text -> Text -> Text -> Text
T.replace Text
find Text
replacement Text
contents
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
contents Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newContents) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Text -> Sem r ()
forall (r :: EffectRow).
MemberWithError File r =>
FilePath -> Text -> Sem r ()
File.write FilePath
file Text
newContents
  Bool -> Sem r Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Sem r Bool) -> Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ Text
contents Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newContents

replaceIO :: MonadIO m => Text -> Text -> FilePath -> m Bool
replaceIO :: Text -> Text -> FilePath -> m Bool
replaceIO Text
find Text
replacement FilePath
file =
  IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
    Sem '[Final IO] Bool -> IO Bool
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal (Sem '[Final IO] Bool -> IO Bool)
-> Sem '[Final IO] Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
      Sem '[Embed IO, Final IO] Bool -> Sem '[Final IO] Bool
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal (Sem '[Embed IO, Final IO] Bool -> Sem '[Final IO] Bool)
-> Sem '[Embed IO, Final IO] Bool -> Sem '[Final IO] Bool
forall a b. (a -> b) -> a -> b
$
        Sem '[File, Embed IO, Final IO] Bool
-> Sem '[Embed IO, Final IO] Bool
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Sem (File : r) a -> Sem r a
runIO (Sem '[File, Embed IO, Final IO] Bool
 -> Sem '[Embed IO, Final IO] Bool)
-> Sem '[File, Embed IO, Final IO] Bool
-> Sem '[Embed IO, Final IO] Bool
forall a b. (a -> b) -> a -> b
$
          (Text -> Text -> FilePath -> Sem '[File, Embed IO, Final IO] Bool
forall (r :: EffectRow).
Member File r =>
Text -> Text -> FilePath -> Sem r Bool
replace Text
find Text
replacement FilePath
file)