-- |  LiBro data transformations for storage
module LiBro.Data.Storage
  (
  -- * Handling of multiple IDs in a single value
    IdList(..)
  , idListToStr
  , strToIdList
  -- * Storable task records
  , TaskRecord(..)
  , tasksToTaskRecords
  , taskRecordsToTasks
  -- * Top level data handling
  , storePersons
  , loadPersons
  , storeTasks
  , loadTasks
  , storeData
  , loadData
  ) where

import LiBro.Base
import LiBro.Config
import LiBro.Data
import LiBro.Data.SafeText
import LiBro.Util
import Data.Function
import Data.Map ((!))
import qualified Data.Map as M
import Data.Tree
import Data.Csv
import qualified Data.ByteString.Char8 as B
import Control.Monad.Reader
import GHC.Generics
import System.FilePath
import System.Directory

-- |  A thin wrapper around lists of 'Int' with a simple
--    (space-separated) 'String' representation.
newtype IdList = IdList { IdList -> [Int]
ids :: [Int] } deriving (IdList -> IdList -> Bool
(IdList -> IdList -> Bool)
-> (IdList -> IdList -> Bool) -> Eq IdList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdList -> IdList -> Bool
== :: IdList -> IdList -> Bool
$c/= :: IdList -> IdList -> Bool
/= :: IdList -> IdList -> Bool
Eq, (forall x. IdList -> Rep IdList x)
-> (forall x. Rep IdList x -> IdList) -> Generic IdList
forall x. Rep IdList x -> IdList
forall x. IdList -> Rep IdList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IdList -> Rep IdList x
from :: forall x. IdList -> Rep IdList x
$cto :: forall x. Rep IdList x -> IdList
to :: forall x. Rep IdList x -> IdList
Generic)

-- |  Simple 'String' representation of an 'IdList': space-separated numbers.
idListToStr :: IdList -> String
idListToStr :: IdList -> String
idListToStr = [String] -> String
unwords ([String] -> String) -> (IdList -> [String]) -> IdList -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String]) -> (IdList -> [Int]) -> IdList -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdList -> [Int]
ids

-- |  Reads space-separated 'Int's to an 'IdList'.
strToIdList :: String -> IdList
strToIdList :: String -> IdList
strToIdList = [Int] -> IdList
IdList ([Int] -> IdList) -> (String -> [Int]) -> String -> IdList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. Read a => String -> a
read ([String] -> [Int]) -> (String -> [String]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

instance Show IdList where
  show :: IdList -> String
show = IdList -> String
idListToStr
instance Read IdList where
  readsPrec :: Int -> ReadS IdList
readsPrec Int
_ String
str = [(String -> IdList
strToIdList String
str, String
"")]
instance FromField IdList where
  parseField :: Field -> Parser IdList
parseField = (String -> IdList) -> Parser String -> Parser IdList
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> IdList
forall a. Read a => String -> a
read (Parser String -> Parser IdList)
-> (Field -> Parser String) -> Field -> Parser IdList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Parser String
forall a. FromField a => Field -> Parser a
parseField
instance ToField IdList where
  toField :: IdList -> Field
toField = String -> Field
B.pack (String -> Field) -> (IdList -> String) -> IdList -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdList -> String
forall a. Show a => a -> String
show

-- |  A data type specialized to store 'Task' information in tables.
data TaskRecord = TaskRecord
  { TaskRecord -> Int
trid          :: Int
  , TaskRecord -> Maybe Int
parentTid     :: Maybe Int
  , TaskRecord -> SafeText
tTitle        :: SafeText
  , TaskRecord -> SafeText
tDescription  :: SafeText
  , TaskRecord -> IdList
tAssignees    :: IdList
  } deriving (Int -> TaskRecord -> ShowS
[TaskRecord] -> ShowS
TaskRecord -> String
(Int -> TaskRecord -> ShowS)
-> (TaskRecord -> String)
-> ([TaskRecord] -> ShowS)
-> Show TaskRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskRecord -> ShowS
showsPrec :: Int -> TaskRecord -> ShowS
$cshow :: TaskRecord -> String
show :: TaskRecord -> String
$cshowList :: [TaskRecord] -> ShowS
showList :: [TaskRecord] -> ShowS
Show, (forall x. TaskRecord -> Rep TaskRecord x)
-> (forall x. Rep TaskRecord x -> TaskRecord) -> Generic TaskRecord
forall x. Rep TaskRecord x -> TaskRecord
forall x. TaskRecord -> Rep TaskRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TaskRecord -> Rep TaskRecord x
from :: forall x. TaskRecord -> Rep TaskRecord x
$cto :: forall x. Rep TaskRecord x -> TaskRecord
to :: forall x. Rep TaskRecord x -> TaskRecord
Generic)

instance Eq TaskRecord where == :: TaskRecord -> TaskRecord -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (TaskRecord -> Int) -> TaskRecord -> TaskRecord -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TaskRecord -> Int
trid
instance DefaultOrdered TaskRecord
instance FromNamedRecord TaskRecord
instance ToNamedRecord TaskRecord

-- |  Store 'Task's using 'TaskRecord's.
tasksToTaskRecords :: Tasks -> [TaskRecord]
tasksToTaskRecords :: Tasks -> [TaskRecord]
tasksToTaskRecords = (Tree Task -> [TaskRecord]) -> Tasks -> [TaskRecord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Int -> Tree Task -> [TaskRecord]
storeTasks' Maybe Int
forall a. Maybe a
Nothing)
  where storeTasks' :: Maybe Int -> Tree Task -> [TaskRecord]
storeTasks' Maybe Int
parent (Node Task
t Tasks
ts) =
          let tr :: TaskRecord
tr  = Maybe Int -> Task -> TaskRecord
toTaskRecord Maybe Int
parent Task
t
              trs :: [[TaskRecord]]
trs = Maybe Int -> Tree Task -> [TaskRecord]
storeTasks' (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Task -> Int
tid Task
t) (Tree Task -> [TaskRecord]) -> Tasks -> [[TaskRecord]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tasks
ts
          in  TaskRecord
tr TaskRecord -> [TaskRecord] -> [TaskRecord]
forall a. a -> [a] -> [a]
: [[TaskRecord]] -> [TaskRecord]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TaskRecord]]
trs
        toTaskRecord :: Maybe Int -> Task -> TaskRecord
toTaskRecord Maybe Int
p Task
t = TaskRecord
          { trid :: Int
trid          = Task -> Int
tid Task
t
          , parentTid :: Maybe Int
parentTid     = Maybe Int
p
          , tTitle :: SafeText
tTitle        = Task -> SafeText
title Task
t
          , tDescription :: SafeText
tDescription  = Task -> SafeText
description Task
t
          , tAssignees :: IdList
tAssignees    = [Int] -> IdList
IdList (Person -> Int
pid (Person -> Int) -> [Person] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Task -> [Person]
assignees Task
t)
          }

-- |  Load 'Task's from 'TaskRecord's. Needs to lookup 'Person's.
taskRecordsToTasks :: Persons -> [TaskRecord] -> Tasks
taskRecordsToTasks :: Persons -> [TaskRecord] -> Tasks
taskRecordsToTasks Persons
pmap [TaskRecord]
trs =
  let tmap :: Map Int TaskRecord
tmap        = [(Int, TaskRecord)] -> Map Int TaskRecord
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, TaskRecord)] -> Map Int TaskRecord)
-> [(Int, TaskRecord)] -> Map Int TaskRecord
forall a b. (a -> b) -> a -> b
$ (TaskRecord -> (Int, TaskRecord))
-> [TaskRecord] -> [(Int, TaskRecord)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) (Int -> TaskRecord -> (Int, TaskRecord))
-> (TaskRecord -> Int) -> TaskRecord -> (Int, TaskRecord)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TaskRecord -> Int
trid) [TaskRecord]
trs
      parentList :: [(Int, Maybe Int)]
parentList  = (TaskRecord -> (Int, Maybe Int))
-> [TaskRecord] -> [(Int, Maybe Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) (Int -> Maybe Int -> (Int, Maybe Int))
-> (TaskRecord -> Int)
-> TaskRecord
-> Maybe Int
-> (Int, Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaskRecord -> Int
trid (TaskRecord -> Maybe Int -> (Int, Maybe Int))
-> (TaskRecord -> Maybe Int) -> TaskRecord -> (Int, Maybe Int)
forall a b.
(TaskRecord -> a -> b) -> (TaskRecord -> a) -> TaskRecord -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaskRecord -> Maybe Int
parentTid) [TaskRecord]
trs
      idForest :: Forest Int
idForest    = [(Int, Maybe Int)] -> Forest Int
forall a. Ord a => ParentList a -> Forest a
readForest [(Int, Maybe Int)]
parentList
  in  (Tree Int -> Tree Task) -> Forest Int -> Tasks
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Task) -> Tree Int -> Tree Task
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Task) -> Tree Int -> Tree Task)
-> (Int -> Task) -> Tree Int -> Tree Task
forall a b. (a -> b) -> a -> b
$ TaskRecord -> Task
fromRecord (TaskRecord -> Task) -> (Int -> TaskRecord) -> Int -> Task
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Int TaskRecord
tmap Map Int TaskRecord -> Int -> TaskRecord
forall k a. Ord k => Map k a -> k -> a
!)) Forest Int
idForest
  where fromRecord :: TaskRecord -> Task
fromRecord TaskRecord
tr = Task
          { tid :: Int
tid         = TaskRecord -> Int
trid TaskRecord
tr
          , title :: SafeText
title       = TaskRecord -> SafeText
tTitle TaskRecord
tr
          , description :: SafeText
description = TaskRecord -> SafeText
tDescription TaskRecord
tr
          , assignees :: [Person]
assignees   = (Persons
pmap Persons -> Int -> Person
forall k a. Ord k => Map k a -> k -> a
!) (Int -> Person) -> [Int] -> [Person]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdList -> [Int]
ids (TaskRecord -> IdList
tAssignees TaskRecord
tr)
          }

-- |  Store 'Person's at the configured storage space
storePersons :: Persons -> LiBro ()
storePersons :: Persons -> LiBro ()
storePersons Persons
pmap = do
  StorageConfig
sconf <- (Config -> StorageConfig) -> LiBro StorageConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> StorageConfig
storage
  let fp :: String
fp = StorageConfig -> String
directory StorageConfig
sconf String -> ShowS
</> StorageConfig -> String
personFile StorageConfig
sconf
  IO () -> LiBro ()
forall a. IO a -> LiBro a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LiBro ()) -> IO () -> LiBro ()
forall a b. (a -> b) -> a -> b
$ String -> [Person] -> IO ()
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
String -> [a] -> IO ()
storeAsXlsx String
fp ([Person] -> IO ()) -> [Person] -> IO ()
forall a b. (a -> b) -> a -> b
$ Persons -> [Person]
forall k a. Map k a -> [a]
M.elems Persons
pmap

-- |  Load a list of 'Person's from the configured storage space.
--    Returns empty data if no input file was found.
loadPersons :: LiBro Persons
loadPersons :: LiBro Persons
loadPersons = do
  StorageConfig
sconf <- (Config -> StorageConfig) -> LiBro StorageConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> StorageConfig
storage
  let fp :: String
fp = StorageConfig -> String
directory StorageConfig
sconf String -> ShowS
</> StorageConfig -> String
personFile StorageConfig
sconf
  Bool
exists <- IO Bool -> LiBro Bool
forall a. IO a -> LiBro a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> LiBro Bool) -> IO Bool -> LiBro Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
  if Bool -> Bool
not Bool
exists then Persons -> LiBro Persons
forall a. a -> LiBro a
forall (m :: * -> *) a. Monad m => a -> m a
return Persons
forall k a. Map k a
M.empty
    else do
      Right [Person]
prs <- IO (Either String [Person]) -> LiBro (Either String [Person])
forall a. IO a -> LiBro a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String [Person]) -> LiBro (Either String [Person]))
-> IO (Either String [Person]) -> LiBro (Either String [Person])
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String [Person])
forall a. FromNamedRecord a => String -> IO (Either String [a])
loadFromXlsx String
fp
      Persons -> LiBro Persons
forall a. a -> LiBro a
forall (m :: * -> *) a. Monad m => a -> m a
return (Persons -> LiBro Persons) -> Persons -> LiBro Persons
forall a b. (a -> b) -> a -> b
$ [Person] -> Persons
personMap [Person]
prs

-- |  Store 'Tasks' at the configured storage space.
storeTasks :: Tasks -> LiBro ()
storeTasks :: Tasks -> LiBro ()
storeTasks Tasks
ts = do
  StorageConfig
sconf <- (Config -> StorageConfig) -> LiBro StorageConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> StorageConfig
storage
  let fp :: String
fp = StorageConfig -> String
directory StorageConfig
sconf String -> ShowS
</> StorageConfig -> String
tasksFile StorageConfig
sconf
  IO () -> LiBro ()
forall a. IO a -> LiBro a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LiBro ()) -> IO () -> LiBro ()
forall a b. (a -> b) -> a -> b
$ String -> [TaskRecord] -> IO ()
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
String -> [a] -> IO ()
storeAsXlsx String
fp ([TaskRecord] -> IO ()) -> [TaskRecord] -> IO ()
forall a b. (a -> b) -> a -> b
$ Tasks -> [TaskRecord]
tasksToTaskRecords Tasks
ts

-- |  Load 'Tasks' from the configured storage space.
--    Needs an additional 'Data.Map.Map' to find 'Person's for given
--    person ids ('Int'). Returns empty data if no input file was found.
loadTasks :: Persons -> LiBro Tasks
loadTasks :: Persons -> LiBro Tasks
loadTasks Persons
pmap = do
  StorageConfig
sconf <- (Config -> StorageConfig) -> LiBro StorageConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> StorageConfig
storage
  let fp :: String
fp = StorageConfig -> String
directory StorageConfig
sconf String -> ShowS
</> StorageConfig -> String
tasksFile StorageConfig
sconf
  Bool
exists <- IO Bool -> LiBro Bool
forall a. IO a -> LiBro a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> LiBro Bool) -> IO Bool -> LiBro Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
  if Bool -> Bool
not Bool
exists then Tasks -> LiBro Tasks
forall a. a -> LiBro a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      Right [TaskRecord]
records <- IO (Either String [TaskRecord])
-> LiBro (Either String [TaskRecord])
forall a. IO a -> LiBro a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String [TaskRecord])
 -> LiBro (Either String [TaskRecord]))
-> IO (Either String [TaskRecord])
-> LiBro (Either String [TaskRecord])
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String [TaskRecord])
forall a. FromNamedRecord a => String -> IO (Either String [a])
loadFromXlsx String
fp
      Tasks -> LiBro Tasks
forall a. a -> LiBro a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tasks -> LiBro Tasks) -> Tasks -> LiBro Tasks
forall a b. (a -> b) -> a -> b
$ Persons -> [TaskRecord] -> Tasks
taskRecordsToTasks Persons
pmap [TaskRecord]
records

-- |  Store a complete dataset at the configured file system
--    locations.
storeData :: LiBroData -> LiBro ()
storeData :: LiBroData -> LiBro ()
storeData LiBroData
ld = do
  Persons -> LiBro ()
storePersons  (Persons -> LiBro ()) -> Persons -> LiBro ()
forall a b. (a -> b) -> a -> b
$ LiBroData -> Persons
persons LiBroData
ld
  Tasks -> LiBro ()
storeTasks    (Tasks -> LiBro ()) -> Tasks -> LiBro ()
forall a b. (a -> b) -> a -> b
$ LiBroData -> Tasks
tasks LiBroData
ld

-- |  Load a complete dataset from the configured file system
--    locations. Returns empty data if no input files were found.
loadData :: LiBro LiBroData
loadData :: LiBro LiBroData
loadData = do
  Persons
pmap <- LiBro Persons
loadPersons
  Tasks
ts   <- Persons -> LiBro Tasks
loadTasks Persons
pmap
  LiBroData -> LiBro LiBroData
forall a. a -> LiBro a
forall (m :: * -> *) a. Monad m => a -> m a
return (LiBroData -> LiBro LiBroData) -> LiBroData -> LiBro LiBroData
forall a b. (a -> b) -> a -> b
$ Persons -> Tasks -> LiBroData
LBS Persons
pmap Tasks
ts