{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-} 
{-# LANGUAGE OverloadedStrings #-} 
{-# LANGUAGE TemplateHaskell #-} 
module Data.Library 
( Library
, ItemId
, LibraryItem(..)
, Error(..)
, empty
, move
, copy
, delete
, rename
, describe
, touch
, new
, unsafeGetItem
, getItem
, getItemMaybe
, showError
, isDir
-- , testItems
)

where
import Data.Text (Text, pack)
import Data.IntSet (IntSet, insert)
import qualified Data.IntSet as IS
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
import Data.Data (Typeable)
import Data.Time.Clock (UTCTime)
import Data.Library.UUIRI (UUIRI, iri, uuid, toUUIRI)
import Control.Applicative ((<$>), (<*>))
import Control.Monad (mzero)
import Data.SafeCopy (deriveSafeCopy, base)
import Data.Maybe (fromMaybe)
import Data.Aeson ( ToJSON(toJSON), FromJSON(parseJSON), object
                  , (.=), (.:), (.:?), Value(Object, Null))

import Data.Indexation.UUID hiding (fromText)
import Data.Indexation.Constraints (Text256, Text4096, fromText)

-- | A Library is just a rebranded Seq
type Library = Seq LibraryItem

type ItemId = Int

empty :: Library
empty = Seq.empty

move :: Library -> ItemId -> ItemId -> UTCTime -> Either Error Library 
move lib origin destination t = if origin == 0 then Left MovingRoot else do
    d <- getItem destination lib    -- destination
    i <- getItem origin lib         -- item
    let parentId = itemParent i
    p <- getItem parentId lib       -- parent
    ud <- addItemInDir i d t        -- updated destination
    up <- rmItemFromDir i p t       -- updated parent
    return $ Seq.update destination ud 
           $ Seq.update parentId up 
           $ Seq.adjust (\item -> item { itemDateModified = t }) origin lib

copy :: Library -> ItemId -> ItemId -> UTCTime -> Either Error Library
copy lib origin destination t = do
    d <- getItem destination lib    -- destination
    i <- getItem origin lib         -- item
    let newParentId = itemId d
        newItem = i { itemDateModified = t
                    , itemId = Seq.length lib
                    , itemParent = newParentId }
    ud <- addItemInDir newItem d t  -- add the copy to the destination
    return $ Seq.update newParentId ud (lib |> newItem)

delete :: Library -> ItemId -> Library
delete lib target = Seq.update target Deleted lib

-- | Changes the name of an item
rename :: Library -> ItemId -> Text -> UTCTime -> Library
rename lib target name t = Seq.adjust (setName t $ fromText name) target lib
    where
        setName t' n i = i { itemDateModified = t', itemName = n }

-- | Sets the description of an item 
describe :: Library -> ItemId -> Text -> UTCTime -> Library
describe lib target description t = 
    Seq.adjust (setDescription t $ fromText description) target lib
    where
        setDescription t' d i = i { itemDateModified = t'
                                  , itemDescription = Just d }

-- | Sets the modified date of an item to the one supplied in arg t
touch :: Library -> ItemId -> UTCTime -> Library
touch lib target t = Seq.adjust (setTime t) target lib
    where
        setTime t' i = i { itemDateModified = t' }

-- | Create a new item in the library 
-- If createing a directory then uuiri must be Nothing
new :: Text -> Maybe Text -> UTCTime -> ItemId -> Maybe UUIRI -> Library 
    -> Either Error Library
new name description creationTime parent uuiri lib = do
    p <- getItem parent lib             -- parent directory
    up <- addItemInDir i p creationTime -- updated parent
    return $ Seq.update parent up       -- updates the library with it
           $ lib |> i                   -- adds the new item to the library
    where
        i = Item (Seq.length lib) (fromText name) (fmap fromText description) 
                 creationTime creationTime parent $ 
                 maybe (Left $ Dir IS.empty IS.empty) Right uuiri

-- | No bounds checking and doesn't filter deleted items
-- returns an exception error when the item is not found
unsafeGetItem :: ItemId -> Library -> LibraryItem
unsafeGetItem = flip Seq.index 

-- | Does bounds checking and also checks if the item was not deleted
getItem :: ItemId -> Library -> Either Error LibraryItem
getItem i l = if i >= Seq.length l 
                then Left $ ItemNotFound i
                else let item = Seq.index l i 
                     in case item of 
                            Deleted -> Left $ ItemNotFound i
                            _ -> Right item

-- | getItem tailored to return an Error if the 2nd argument is Nothing
getItemMaybe :: ItemId -> Maybe Library -> Either Error LibraryItem
getItemMaybe i (Just l) = getItem i l
getItemMaybe _ Nothing = Left InvalidContainer
--- // ---
-- HELPERS
itemOpInDir :: (Int -> IntSet -> IntSet) -> LibraryItem -> LibraryItem 
            -> UTCTime -> Either Error LibraryItem
itemOpInDir op item dir t = 
    case itemType dir of
        Right _ -> Left $ InvalidDestination (itemId dir)
        Left (Dir files dirs) -> Right $ 
            if isDir item 
                then dir { itemDateModified = t
                         , itemType = Left $ Dir files (op (itemId item) dirs) 
                         }
                else dir { itemDateModified = t
                         , itemType = Left $ Dir (op (itemId item) files) dirs
                         }

addItemInDir :: LibraryItem -> LibraryItem -> UTCTime 
             -> Either Error LibraryItem
addItemInDir = itemOpInDir insert 

rmItemFromDir :: LibraryItem -> LibraryItem -> UTCTime 
              -> Either Error LibraryItem
rmItemFromDir = itemOpInDir IS.delete
-- HELPERS
--- // ---

-- | An item in the library
data LibraryItem = 
    Deleted | 
    Item 
    { itemId           :: !ItemId -- root dir is 0
    , itemName         :: !Text256
    , itemDescription  :: !(Maybe Text4096) -- short description
    , itemDateCreated  :: !UTCTime
    , itemDateModified :: !UTCTime
    , itemParent       :: !ItemId -- root dir has parent = 0
    , itemType         :: !(Either Directory UUIRI)
    } deriving (Typeable)

{-
testItems t = 
    [ Item 0 "teste" (Just "isto eh um teste") t t 0 (Left (IS.singleton 1,IS.singleton 2))
    , f1 t, d1 t
    ]
f1 t = Item 1 "f1" (Just "ficheiro 1") t t 0 (Right $ toUUIRI (UUID $ fromWords 1 2 3 4) "http://blah.com/f1.txt")
d1 t = Item 2 "d1" (Just "dir 1") t t 0 (Left (IS.empty, IS.empty))
-}

instance ToJSON LibraryItem where
    toJSON Deleted = Null
    toJSON (Item iid iname idesc icreated imodified iparent itype) = object $
        case itype of
            Right f -> ("uuid", toJSON (uuid f)) : ("url", toJSON (iri f)) :
                       ("subdirectories", Null) : ("files",Null) : common
            Left (Dir f d) -> 
                ("uuid", Null) : ("url", Null) : 
                ("subdirectories", toJSON d) : ("files", toJSON f) : 
                common
        where 
            common = ["id" .= iid, "name" .= iname, "description" .= idesc
                     , "created" .= icreated, "modified" .= imodified
                     , "parent" .= iparent 
                     ]

instance FromJSON LibraryItem where
    parseJSON Null = return Deleted
    parseJSON (Object i) = Item <$> i .: "id" 
                                <*> i .: "name"
                                <*> i .: "description"
                                <*> i .: "created"
                                <*> i .: "modified"
                                <*> i .: "parent"
                                <*> do fuuid  <- i .:? "uuid"
                                       furl   <- i .:? "url"
                                       dfiles <- i .:? "files"
                                       ddirs  <- i .:? "subdirectories"
                                       return $ case furl of
                                         Nothing -> makeDir dfiles ddirs
                                         Just f -> makeUUIRI fuuid f
        where
            makeDir :: Maybe IntSet -> Maybe IntSet -> Either Directory UUIRI
            makeDir i1 i2 = Left $ Dir (fromMaybe (IS.empty) i1) 
                                       (fromMaybe (IS.empty) i2)
            makeUUIRI :: Maybe UUID -> Text -> Either Directory UUIRI
            makeUUIRI u iri' = Right $ toUUIRI (fromMaybe nil u) iri'
    parseJSON _          = mzero

isDir :: LibraryItem -> Bool
isDir i = case itemType i of 
            Right _ -> True
            _ -> False

-- | A directory is just a pair of IntSet's where the first one has the
-- files, and the second has the subdirectories 
data Directory = Dir !IntSet !IntSet


-- | Some errors that might occur
data Error = InvalidDestination ItemId
           | ItemNotFound ItemId
           | InvalidContainer
           | MovingRoot
           deriving(Eq, Ord, Typeable)
instance Show Error where
    show (InvalidDestination i) = "Invalid destination with id " ++ (show i)
    show (ItemNotFound i) = "Item with id " ++ (show i) ++ " not found"
    show MovingRoot = "Cannot move root directory"

showError :: Error -> Text
showError e = pack $ show e
{-
newFileTextIO :: Text -> Text -> IO FileText
newFileTextIO n c = do
    t <- getCurrentTime
    return $ newFileText n t c
-}

$(deriveSafeCopy 0 'base ''Error)
$(deriveSafeCopy 0 'base ''Directory)
$(deriveSafeCopy 0 'base ''LibraryItem)