{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Hero.Keep
  ( HeroKeep,
    GetComics (..),
    getComics,
    NewComic (..),
    newComic,
    open,
    close,
  )
where

import Alpha
import Data.Acid (Update, makeAcidic)
import qualified Data.Acid as Acid
import Data.Data (Data, Typeable)
import Data.IxSet (Indexable (..), IxSet, ixFun, ixSet)
import qualified Data.IxSet as IxSet
import Data.SafeCopy (base, deriveSafeCopy)
import qualified Data.Text as Text
import Hero.Core

-- * Keep

-- | Main database.
data HeroKeep = HeroKeep
  { _comics :: IxSet Comic,
    _users :: IxSet User
  }
  deriving (Data, Typeable)

$(deriveSafeCopy 0 'base ''HeroKeep)

-- * Index @Comic@

$(deriveSafeCopy 0 'base ''Comic)

$(deriveSafeCopy 0 'base ''User)

$(deriveSafeCopy 0 'base ''ComicId)

instance Indexable Comic where
  empty =
    ixSet
      [ ixFun <| \c -> [comicId c],
        ixFun <| \c -> [comicPages c],
        ixFun <| \c -> [comicName c],
        ixFun <| \c -> [comicIssue c],
        ixFun <| \c -> [comicDescription c]
      ]

instance Indexable User where
  empty =
    ixSet
      [ ixFun <| \u -> [userEmail u],
        ixFun <| \u -> [userName u],
        ixFun <| \u -> [userLibrary u]
      ]

newComic :: Comic -> Update HeroKeep Comic
newComic c = do
  keep <- get
  put <| keep {_comics = IxSet.insert c (_comics keep)}
  pure c

getComics :: Int -> Acid.Query HeroKeep [Comic]
getComics n = ask /> _comics /> IxSet.toList /> take n

-- * Opening the keep

$(makeAcidic ''HeroKeep ['newComic, 'getComics])

initialHeroKeep :: HeroKeep
initialHeroKeep =
  HeroKeep
    { _comics = IxSet.fromList [theRed],
      _users =
        IxSet.fromList
          [ User "a" "micheal" [],
            User "b" "ben" []
          ]
    }
  where
    theRed =
      Comic
        { comicId = "1",
          comicPages = 42,
          comicName = "The Red",
          comicIssue = "1.0",
          comicDescription =
            Text.unlines
              [ "In the future, a nuclear world war has changed the course",
                "of history forever. A single government entity now presides",
                "over what's left of the world, and prohibits certain content",
                "that is deemed emotionall dangerous, or \"red\", in attempt",
                "to maintain order and keep society working..."
              ]
        }

open :: String -> IO (Acid.AcidState HeroKeep)
open dir = Acid.openLocalStateFrom dir initialHeroKeep

close :: Acid.AcidState HeroKeep -> IO ()
close = Acid.closeAcidState