    --------------------------------------------------------------------------------
    -- | A store for storing and retreiving items
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE ScopedTypeVariables       #-}
    module Hakyll.Core.Store
        ( Store
        , Result (..)
        , toMaybe
        , new
        , set
        , get
        , isMember
        , delete
        , hash
        ) where

    --------------------------------------------------------------------------------
    import           Control.Exception    (IOException, handle)
    import qualified Crypto.Hash.MD5      as MD5
    import           Data.Binary          (Binary, decode, encodeFile)
    import qualified Data.ByteString      as B
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.Cache.LRU.IO    as Lru
    import           Data.List            (intercalate)
    import           Data.Maybe           (isJust)
    import qualified Data.Text            as T
    import qualified Data.Text.Encoding   as T
    import           Data.Typeable        (TypeRep, Typeable, cast, typeOf)
    import           System.Directory     (createDirectoryIfMissing)
    import           System.Directory     (doesFileExist, removeFile)
    import           System.FilePath      ((</>))
    import           System.IO            (IOMode (..), hClose, openFile)
    import           Text.Printf          (printf)

    --------------------------------------------------------------------------------
    -- | Simple wrapper type
    data Box = forall a. Typeable a => Box a

    --------------------------------------------------------------------------------
    data Store = Store
        { -- | All items are stored on the filesystem
          storeDirectory :: FilePath
        , -- | Optionally, items are also kept in-memory
          storeMap       :: Maybe (Lru.AtomicLRU FilePath Box)
        }

    --------------------------------------------------------------------------------
    instance Show Store where
        show _ = "<Store>"

    --------------------------------------------------------------------------------
    -- | Result of a store query
    data Result a
        = Found a                    -- ^ Found, result
        | NotFound                   -- ^ Not found
        | WrongType TypeRep TypeRep  -- ^ Expected, true type
        deriving (Show, Eq)

    --------------------------------------------------------------------------------
    -- | Convert result to 'Maybe'
    toMaybe :: Result a -> Maybe a
    toMaybe (Found x) = Just x
    toMaybe _         = Nothing

    --------------------------------------------------------------------------------
    -- | Initialize the store
    new :: Bool      -- ^ Use in-memory caching
        -> FilePath  -- ^ Directory to use for hard disk storage
        -> IO Store  -- ^ Store
    new inMemory directory = do
        createDirectoryIfMissing True directory
        ref <- if inMemory then Just <$> Lru.newAtomicLRU csize else return Nothing
        return Store
            { storeDirectory = directory
            , storeMap       = ref
            }
      where
        csize = Just 500

    --------------------------------------------------------------------------------
    -- | Auxiliary: add an item to the in-memory cache
    cacheInsert :: Typeable a => Store -> String -> a -> IO ()
    cacheInsert (Store _ Nothing)    _   _     = return ()
    cacheInsert (Store _ (Just lru)) key x =
        Lru.insert key (Box x) lru

    --------------------------------------------------------------------------------
    -- | Auxiliary: get an item from the in-memory cache
    cacheLookup :: forall a. Typeable a => Store -> String -> IO (Result a)
    cacheLookup (Store _ Nothing)    _   = return NotFound
    cacheLookup (Store _ (Just lru)) key = do
        res <- Lru.lookup key lru
        return $ case res of
            Nothing      -> NotFound
            Just (Box x) -> case cast x of
                Just x' -> Found x'
                Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x)

    --------------------------------------------------------------------------------
    cacheIsMember :: Store -> String -> IO Bool
    cacheIsMember (Store _ Nothing)    _   = return False
    cacheIsMember (Store _ (Just lru)) key = isJust <$> Lru.lookup key lru

    --------------------------------------------------------------------------------
    -- | Auxiliary: delete an item from the in-memory cache
    cacheDelete :: Store -> String -> IO ()
    cacheDelete (Store _ Nothing)    _   = return ()
    cacheDelete (Store _ (Just lru)) key = do
        _ <- Lru.delete key lru
        return ()

    --------------------------------------------------------------------------------
    -- | Store an item
    set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
    set store identifier value = do
        encodeFile (storeDirectory store </> key) value
        cacheInsert store key value
      where
        key = hash identifier

    --------------------------------------------------------------------------------
    -- | Load an item
    get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
    get store identifier = do
        -- First check the in-memory map
        ref <- cacheLookup store key
        case ref of
            -- Not found in the map, try the filesystem
            NotFound -> do
                exists <- doesFileExist path
                if not exists
                    -- Not found in the filesystem either
                    then return NotFound
                    -- Found in the filesystem
                    else do
                        v <- decodeClose
                        cacheInsert store key v
                        return $ Found v
            -- Found in the in-memory map (or wrong type), just return
            s -> return s
      where
        key  = hash identifier
        path = storeDirectory store </> key

        -- 'decodeFile' from Data.Binary which closes the file ASAP
        decodeClose = do
            h   <- openFile path ReadMode
            lbs <- BL.hGetContents h
            BL.length lbs `seq` hClose h
            return $ decode lbs

    --------------------------------------------------------------------------------
    -- | Strict function
    isMember :: Store -> [String] -> IO Bool
    isMember store identifier = do
        inCache <- cacheIsMember store key
        if inCache then return True else doesFileExist path
      where
        key  = hash identifier
        path = storeDirectory store </> key

    --------------------------------------------------------------------------------
    -- | Delete an item
    delete :: Store -> [String] -> IO ()
    delete store identifier = do
        cacheDelete store key
        deleteFile $ storeDirectory store </> key
      where
        key  = hash identifier

    --------------------------------------------------------------------------------
    -- | Delete a file unless it doesn't exist...
    deleteFile :: FilePath -> IO ()
    deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile

    --------------------------------------------------------------------------------
    -- | Mostly meant for internal usage
    hash :: [String] -> String
    hash = concatMap (printf "%02x") . B.unpack .
        MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"