Cacher is the code snippet organizer for pro developers

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeFamilies       #-}


import           Control.Monad.Reader
import           Control.Monad.State
import           Data.Acid
import           Data.Acid.Local
import           Data.SafeCopy
import           Data.Typeable

-- | Initial Data Type

-- Step 1 : define your data types, including deriveSafeCopy (1),
-- makeLenses, functions on state (Query, Update)

-- Step 2 : load it into acid-state

-- Step 3 : State is now made, so now migrate,
    --- so rename original data, increment
    --- derive SafeCopy, update methods, define migration, run it.
    ---

type Name     = String
type Address  = String

-- data Contacts_v1 = Contacts_v1 [(Name, Address)]
-- $(deriveSafeCopy 1 'base ''Contacts_v1)

type Phone = String

data Contacts = Contacts [Contact] deriving (Typeable, Show)

data Contact = Contact { name    :: Name
                       , address :: Address
                       , phone   :: Phone
                       } deriving (Typeable, Show)

$(deriveSafeCopy 1 'base ''Contact)
-- $(deriveSafeCopy 2 'extension ''Contacts)

$(deriveSafeCopy 2 'base ''Contacts)

-- {- Here the magic happens: -}
-- instance Migrate Contacts where
--      type MigrateFrom Contacts = Contacts_v1
--      migrate (Contacts_v1 contacts) = Contacts [ Contact { name    = name
--                                                          , address = address
--                                                          , phone   = "" }
--                                                  | (name, address) <- contacts ]

addContact :: Contact -> Update Contacts ()
addContact x = do Contacts xs <- get
                  put $ Contacts (x:xs)

getContacts :: Query Contacts Contacts
getContacts = ask

$(makeAcidic ''Contacts ['addContact, 'getContacts])

main :: IO ()
main = do acid <- openLocalStateFrom "state" (Contacts [])
          c <- query acid GetContacts
          print c
          createCheckpointAndClose acid


-- -- | Type to Migrate

-- data Contacts_v0 = Contacts_v0 [(Name, Address)]

-- instance SafeCopy Contacts_v0 where
--      putCopy (Contacts_v0 list) = contain $ safePut list
--      getCopy = contain $ Contacts_v0 <$> safeGet

-- data Contact = Contact { name    :: Name
--                         , address :: Address
--                         , phone   :: Phone }
-- instance SafeCopy Contact where
--     putCopy Contact{..} = contain $ do safePut name; safePut address; safePut phone
--     getCopy = contain $ Contact <$> safeGet <*> safeGet <*> safeGet

-- -- | Rename here?

-- data Contacts = Contacts [Contact]



-- instance SafeCopy Contacts where
--      version = 1
--      kind = extension
--      putCopy (Contacts contacts) = contain $ safePut contacts
--      getCopy = contain $ Contacts <$> safeGet

-- {- Here the magic happens: -}
-- instance Migrate Contacts where
--      type MigrateFrom Contacts = Contacts_v0
--      migrate (Contacts_v0 contacts) = Contacts [ Contact{ name    = name
--                                                         , address = address
--                                                         , phone   = "" }
--                                                | (name, address) <- contacts ]