-- | Defines a monad context for caching.

module Capabilities.Cache (
  MonadCache (..),
  cache,
  short,
  ) where

import qualified Data.ByteString.Lazy   as LBS (fromStrict)
import qualified Data.ByteString.UTF8   as BS (fromString)

import Control.Monad                    (when)
import Control.Monad.Trans.Class        (MonadTrans (lift))
import Control.OutputCapable.Blocks.Generic (
  GenericReportT
  )
import Data.ByteString                  (ByteString)
import Data.Digest.Pure.SHA             (sha256, showDigest)

class Monad m => MonadCache m where
  appendCollisionFile :: FilePath -> String -> m ()
  doesCacheExist :: FilePath -> m Bool
  readShowFile :: FilePath -> m ByteString
  writeShowFile :: FilePath -> ByteString -> m ()

instance MonadCache m => MonadCache (GenericReportT l o m)  where
  appendCollisionFile :: FilePath -> FilePath -> GenericReportT l o m ()
appendCollisionFile FilePath
f = m () -> GenericReportT l o m ()
forall (m :: * -> *) a. Monad m => m a -> GenericReportT l o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GenericReportT l o m ())
-> (FilePath -> m ()) -> FilePath -> GenericReportT l o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> m ()
forall (m :: * -> *). MonadCache m => FilePath -> FilePath -> m ()
appendCollisionFile FilePath
f
  doesCacheExist :: FilePath -> GenericReportT l o m Bool
doesCacheExist = m Bool -> GenericReportT l o m Bool
forall (m :: * -> *) a. Monad m => m a -> GenericReportT l o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> GenericReportT l o m Bool)
-> (FilePath -> m Bool) -> FilePath -> GenericReportT l o m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m Bool
forall (m :: * -> *). MonadCache m => FilePath -> m Bool
doesCacheExist
  readShowFile :: FilePath -> GenericReportT l o m ByteString
readShowFile = m ByteString -> GenericReportT l o m ByteString
forall (m :: * -> *) a. Monad m => m a -> GenericReportT l o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> GenericReportT l o m ByteString)
-> (FilePath -> m ByteString)
-> FilePath
-> GenericReportT l o m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ByteString
forall (m :: * -> *). MonadCache m => FilePath -> m ByteString
readShowFile
  writeShowFile :: FilePath -> ByteString -> GenericReportT l o m ()
writeShowFile FilePath
f = m () -> GenericReportT l o m ()
forall (m :: * -> *) a. Monad m => m a -> GenericReportT l o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GenericReportT l o m ())
-> (ByteString -> m ()) -> ByteString -> GenericReportT l o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> m ()
forall (m :: * -> *).
MonadCache m =>
FilePath -> ByteString -> m ()
writeShowFile FilePath
f

{-|
Caches some file which is generated by using some 'Show'able input.
The textual representation (using 'show') of the input is stored in a file
next to the generated output.
The provided file path is extended by the provided name, a hash of the textual
representation of the input, and the extension.
-}
cache
  :: (MonadCache m, Show a)
  => FilePath
  -- ^ base file path (prefix of file name)
  -> String
  -- ^ path suffix (including dot and extension)
  -> String
  -- ^ some identifying name for what (part of file name)
  -> a
  -- ^ what
  -> (a -> m ByteString)
  -- ^ how to create something from what
  -> m FilePath
cache :: forall (m :: * -> *) a.
(MonadCache m, Show a) =>
FilePath
-> FilePath -> FilePath -> a -> (a -> m ByteString) -> m FilePath
cache FilePath
path FilePath
ext FilePath
name a
what a -> m ByteString
how = (FilePath
file FilePath -> m () -> m FilePath
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m FilePath)
-> (m ByteString -> m ()) -> m ByteString -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ByteString -> m ()
forall {m :: * -> *}. MonadCache m => m ByteString -> m ()
cacheBy (m ByteString -> m FilePath) -> m ByteString -> m FilePath
forall a b. (a -> b) -> a -> b
$ a -> m ByteString
how a
what
  where
    cacheBy :: m ByteString -> m ()
cacheBy m ByteString
create = do
      let create' :: m ()
create' = m ByteString
create m ByteString -> (ByteString -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m ()
forall (m :: * -> *).
MonadCache m =>
FilePath -> ByteString -> m ()
writeShowFile FilePath
file m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                    FilePath -> ByteString -> m ()
forall (m :: * -> *).
MonadCache m =>
FilePath -> ByteString -> m ()
writeShowFile FilePath
whatFile ByteString
what'
      isFile <- FilePath -> m Bool
forall (m :: * -> *). MonadCache m => FilePath -> m Bool
doesCacheExist FilePath
file
      if isFile
        then do
          f <- readShowFile whatFile
          when (f /= what') $ do
            appendCollisionFile (path ++ "busted.txt") whatId
            create'
        else create'
    what' :: ByteString
what' = FilePath -> ByteString
BS.fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall a. Show a => a -> FilePath
show a
what
    whatId :: FilePath
whatId = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Digest SHA256State -> FilePath
forall t. Digest t -> FilePath
showDigest (ByteString -> Digest SHA256State
sha256 (ByteString -> Digest SHA256State)
-> ByteString -> Digest SHA256State
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
what')
    whatFile :: FilePath
whatFile = FilePath
whatId FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hs"
    file :: FilePath
file = FilePath
whatId FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ext

short :: Enum a => a -> String
short :: forall a. Enum a => a -> FilePath
short a
x = Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
x