{-# LANGUAGE FlexibleInstances #-}

{- HLINT ignore "Use writeFile" -}

module Drasil.FileHandling.WriteFiles
  ( Writeable (..),
    WritePolicy (..),
  )
where

import Data.ByteString.Char8 qualified as B
import Data.ByteString.Lazy.Char8 qualified as LB
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Prettyprinter qualified as PNew
import Prettyprinter.Render.Text (renderIO)
import System.File.OsPath (withFile)
import System.IO (Handle, IOMode (..), hPutStr, hPutStrLn)
import System.OsPath (OsPath)
import Text.PrettyPrint qualified as PLegacy
import Prelude hiding (writeFile)

-- | How should files be written?
data WritePolicy
  = -- | With a trailing newline?
    AppendNewline
  | -- | Or without one?
    ExactBytes

-- | Write arbitrary things to a file (respecting a 'WritePolicy').
class Writeable doc where
  writeToFile :: OsPath -> WritePolicy -> doc -> IO ()

-- | Renders the document before writing using plain rendering style.
instance Writeable PLegacy.Doc where
  -- Does conversion to `String` and then does plain `String -> IO ()` writing.
  writeToFile :: OsPath -> WritePolicy -> Doc -> IO ()
writeToFile OsPath
fp WritePolicy
pol = OsPath -> WritePolicy -> String -> IO ()
writeFileStr OsPath
fp WritePolicy
pol (String -> IO ()) -> (Doc -> String) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
PLegacy.render
  {-# INLINE writeToFile #-}

-- | Renders the document before writing using plain rendering style.
instance Writeable (PNew.Doc ann) where
  -- `renderIO` skips intermediate representations before writing to disk:
  -- <https://hackage-content.haskell.org/package/prettyprinter-1.7.2/docs/Prettyprinter-Render-Text.html#v:renderIO>
  writeToFile :: OsPath -> WritePolicy -> Doc ann -> IO ()
writeToFile = (Handle -> Doc ann -> IO ())
-> (Handle -> Doc ann -> IO ())
-> OsPath
-> WritePolicy
-> Doc ann
-> IO ()
forall a r.
(Handle -> a -> IO r)
-> (Handle -> a -> IO r) -> OsPath -> WritePolicy -> a -> IO r
writeFile Handle -> Doc ann -> IO ()
forall {ann}. Handle -> Doc ann -> IO ()
withNL Handle -> Doc ann -> IO ()
forall {ann}. Handle -> Doc ann -> IO ()
write
    where
      write :: Handle -> Doc ann -> IO ()
write Handle
h Doc ann
d = Handle -> SimpleDocStream ann -> IO ()
forall ann. Handle -> SimpleDocStream ann -> IO ()
renderIO Handle
h (LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PNew.layoutPretty LayoutOptions
PNew.defaultLayoutOptions Doc ann
d)
      withNL :: Handle -> Doc ann -> IO ()
withNL Handle
h Doc ann
d = Handle -> Doc ann -> IO ()
forall {ann}. Handle -> Doc ann -> IO ()
write Handle
h (Doc ann
d Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PNew.<> Doc ann
forall ann. Doc ann
PNew.line)
  {-# INLINE writeToFile #-}

instance Writeable String where
  writeToFile :: OsPath -> WritePolicy -> String -> IO ()
writeToFile = OsPath -> WritePolicy -> String -> IO ()
writeFileStr
  {-# INLINE writeToFile #-}

instance Writeable T.Text where
  writeToFile :: OsPath -> WritePolicy -> Text -> IO ()
writeToFile = (Handle -> Text -> IO ())
-> (Handle -> Text -> IO ())
-> OsPath
-> WritePolicy
-> Text
-> IO ()
forall a r.
(Handle -> a -> IO r)
-> (Handle -> a -> IO r) -> OsPath -> WritePolicy -> a -> IO r
writeFile Handle -> Text -> IO ()
TIO.hPutStrLn Handle -> Text -> IO ()
TIO.hPutStr
  {-# INLINE writeToFile #-}

instance Writeable B.ByteString where
  writeToFile :: OsPath -> WritePolicy -> ByteString -> IO ()
writeToFile = (Handle -> ByteString -> IO ())
-> (Handle -> ByteString -> IO ())
-> OsPath
-> WritePolicy
-> ByteString
-> IO ()
forall a r.
(Handle -> a -> IO r)
-> (Handle -> a -> IO r) -> OsPath -> WritePolicy -> a -> IO r
writeFile Handle -> ByteString -> IO ()
B.hPutStrLn Handle -> ByteString -> IO ()
B.hPut
  {-# INLINE writeToFile #-}

instance Writeable LB.ByteString where
  writeToFile :: OsPath -> WritePolicy -> ByteString -> IO ()
writeToFile = (Handle -> ByteString -> IO ())
-> (Handle -> ByteString -> IO ())
-> OsPath
-> WritePolicy
-> ByteString
-> IO ()
forall a r.
(Handle -> a -> IO r)
-> (Handle -> a -> IO r) -> OsPath -> WritePolicy -> a -> IO r
writeFile Handle -> ByteString -> IO ()
LB.hPutStrLn Handle -> ByteString -> IO ()
LB.hPut
  {-# INLINE writeToFile #-}

-- | Internal: Write a 'String' to the given 'OsPath' respecting the
-- 'WritePolicy'.
writeFileStr :: OsPath -> WritePolicy -> String -> IO ()
writeFileStr :: OsPath -> WritePolicy -> String -> IO ()
writeFileStr = (Handle -> String -> IO ())
-> (Handle -> String -> IO ())
-> OsPath
-> WritePolicy
-> String
-> IO ()
forall a r.
(Handle -> a -> IO r)
-> (Handle -> a -> IO r) -> OsPath -> WritePolicy -> a -> IO r
writeFile Handle -> String -> IO ()
hPutStrLn Handle -> String -> IO ()
hPutStr
{-# INLINE writeFileStr #-}

-- | Internal: Write to an 'OsPath' with a 'WritePolicy' appropriate writer.
writeFile ::
  -- | 'AppendNewline' writer.
  (Handle -> a -> IO r) ->
  -- | 'ExactBytes' writer.
  (Handle -> a -> IO r) ->
  -- | The file to be written to.
  OsPath ->
  -- | The 'WritePolicy'.
  WritePolicy ->
  -- | The data to be written.
  a ->
  IO r
writeFile :: forall a r.
(Handle -> a -> IO r)
-> (Handle -> a -> IO r) -> OsPath -> WritePolicy -> a -> IO r
writeFile Handle -> a -> IO r
append Handle -> a -> IO r
_     OsPath
rp WritePolicy
AppendNewline = OsPath -> IOMode -> (Handle -> IO r) -> IO r
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
rp IOMode
WriteMode ((Handle -> IO r) -> IO r) -> (a -> Handle -> IO r) -> a -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> a -> IO r) -> a -> Handle -> IO r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> a -> IO r
append
writeFile Handle -> a -> IO r
_      Handle -> a -> IO r
exact OsPath
rp WritePolicy
ExactBytes    = OsPath -> IOMode -> (Handle -> IO r) -> IO r
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
rp IOMode
WriteMode ((Handle -> IO r) -> IO r) -> (a -> Handle -> IO r) -> a -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> a -> IO r) -> a -> Handle -> IO r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> a -> IO r
exact
{-# INLINE writeFile #-}