module Actions where

import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Exit



-----------------------------------------------------------------------
-- Atomic actions
-- These may modify the state of the lab 


move :: Object -> Start -> End -> Action
move (Object name) (Start loc1) (End loc2) = 
    inLog $ tell ["Move "++ name ++ " from " ++ (show loc1) 
            ++ " to " ++ (show loc2)]

delid :: Object -> LidLoc -> Action
delid (Object name) (LidLoc lidLoc) = 
    inLog $ tell ["Delid "++ name ++ " to " ++ (show lidLoc)]

cover :: Object -> LidLoc -> Action
cover (Object name) (LidLoc lidLoc) = 
    inLog $ tell ["Cover " ++ name ++ " with cover from " ++ (show lidLoc)]


pour :: Component -> Volume -> Container1 -> Container2 -> Action
pour (Component component) (Volume volume) 
         (Container1 container1) (Container2 container2) = 
    do (Lab lab) <- inLab $ get
       let newlab = addComponent component container2 lab
       inLab $ put (Lab newlab)
       inLog $ tell
	  ["Pour " ++ volume ++ " of " ++ (show component) 
            ++ " from " ++ container1 ++ " to " ++ container2]


seal :: Object -> Goal -> Method -> Action
seal (Object equipment) (Goal goal) (Method method) = 
    inLog $ tell ["Seal " ++ equipment ++ " by " ++ method 
                          ++ " in order " ++ goal]


streak :: Component -> Object -> Equipment -> Goal -> Action
streak (Component component) (Object obj) (Equipment equipment) (Goal goal) =
    do (Lab lab) <- inLab $ get
       let newlab = addComponent SingleYeastColony obj lab
       inLab $ put (Lab newlab)
       inLog $ tell ["Using " ++ equipment ++ ", streak " ++ (show component) 
                           ++ " across " ++ obj ++ " in order " ++ goal]


rename :: OldName -> NewName -> Action
rename (OldName oldname) (NewName newname) =  
    do (Lab lab) <- inLab $ get
       let newlab = l_rename oldname newname lab
       inLab $ put (Lab newlab)
       inLog $ tell
          ["Rename " ++ oldname ++ " => " ++ newname]


wait :: Time -> Goal -> Action
wait (Time time) (Goal goal) = 
    inLog $ tell ["Wait for " ++ time ++ " in order " ++ goal]


add :: Component -> Volume -> Container1 -> Container2 -> Equipment -> Action
add (Component component) (Volume volume) (Container1 container1) 
      (Container2 container2) (Equipment equipment) = 
    do (Lab lab) <- inLab $ get
       let newlab = addComponent component container2 lab
       inLab $ put (Lab newlab)
       inLog $ tell
	  ["Using " ++ equipment ++ ", add " ++ volume ++ " of " 
           ++ (show component) ++ " from " 
           ++ container1 ++ " to " ++ container2]


incubate :: Object -> Equipment -> RPM -> Temperature -> TimeInterval -> Goal -> Action
incubate (Object name) (Equipment equipment) (RPM rpm) (Temperature temp) (TimeInterval fromTime toTime) (Goal goal) =
     inLog $ tell ["Incubate " ++ name ++ " in " ++ equipment ++ " at " ++ (show temp) ++ " degC, " ++ (show rpm) ++ "rpm in order " ++ goal]  




------------------------------------------------------------------------
-- Command actions
-- These may change the execution flow but do not modify the state of the lab

stop :: Action
stop = exitWith "Stopped"

continue :: Action
continue = return ()



check :: Condition -> Action
check (Condition test yes_action no_action) =
    do 
      lab <- inLab $ get
      if test lab 
        then do yes_action 
        else do no_action


-- Store is not a command action but should be an experiment action, like wait
-- store :: Name -> StorageConditions -> Action
-- store object storageConds = 
--    do 
--      lab <- inLab $ get
--      updatedLab = storeWithConds object storageconds lab
--      inLab $ put updatedLab 
--      inLog $ tell ["Storing" ++ object]


-- What does go mean? Do we return to the place we jumped from or stop?
-- go :: Action -> Action
-- go action = 
--     do
--       action
--       stop


------------------------------------------------------------

-- Conditions

ifCondition :: (Lab -> Bool) -> Action -> Action -> Condition
ifCondition = Condition

preCondition,postCondition :: (Lab->Bool) -> Condition 
preCondition  test = Condition test continue stop
postCondition test = Condition test continue stop

-- storeCondition :: (Lab->Bool) -> Condition
-- storeCondition test = Condition test store continue


-------------------------------------------------------------
-- Tests

type Test      = Lab -> Bool


isIn :: Location -> Name -> Test
isIn loc name (Lab lab) = 
    True



------------------------------------------------------------------
-- Types


data Location  = In BasicEquipment | Store | ColdRoom

instance Show Location where
    show Store = "store"
    show ColdRoom = "cold room"
    show (In loc) = show loc

data LabEquipment = LabEquipment BasicEquipment Components String -- name

-- Display the assigned name of the equipment if it has one, and its 
-- contents if if has any
instance Show LabEquipment where
    show (LabEquipment e c n) = (if n == "" then show e ++ show c
                                else n) 
                                ++ (if not (null c) then show c else "")


data BasicEquipment = 
           Vial | InoculatingLoop | ConicalFlask | CentrifugeTube
         | PetriDish | BunsenBurner | LaminarFlowHood | Centrifuge
         | Autoclave | Spectrophotometer | VortexMixer | Pipette
         | HotCupboard | Flask  | Beaker | Jar | Bottle | ShakingIncubator
         | Minus80 | NonShakingIncubator



instance Show BasicEquipment where
    show Vial = "vial"
    show InoculatingLoop = "inoculating loop"
    show ConicalFlask = "conical flask"
    show CentrifugeTube = "centrifuge tube"
    show PetriDish = "petri dish"
    show BunsenBurner = "bunsen burner"
    show LaminarFlowHood = "laminar flow hood"
    show Centrifuge = "centrifuge"
    show Autoclave = "autoclave"
    show Bottle = "bottle"
    show Pipette = "pipette"
    show ShakingIncubator = "shaking incubator"
    show NonShakingIncubator = "non-shaking incubator"
    show Minus80 = "-80C freezer"
    show HotCupboard = "hot cupboard"


type Components = [Material]
data Material   = YPDAgar | YPDMedium | Yeast | SingleYeastColony


instance Show Material where
    show YPDAgar = "YPD agar"
    show YPDMedium = "YPD medium"
    show Yeast = "yeast"
    show SingleYeastColony = "single yeast colony"


type Name       = String 


data Object     = Object Name
data Equipment  = Equipment Name
data Start      = Start Location
data End        = End Location
data LidLoc     = LidLoc Location
data Volume     = Volume String
data Container1 = Container1 Name
data Container2 = Container2 Name
data Component  = Component Material
data Method     = Method String
data Goal       = Goal String
data Time       = Time String
data TimeInterval = TimeInterval String String
data OldName    = OldName Name
data NewName    = NewName Name
data RPM        = RPM Int
data Temperature = Temperature Int  -- always in degrees C
data Condition  = Condition (Lab ->Bool) Action Action

-------------------------------------------------------------------

type Log        = [String]

data Lab        = Lab [LabEquipment] deriving Show


type Action     = ExitT String (WriterT Log (State Lab)) ()


inLab = lift . lift
inLog = lift


-------------------------------------------------------------------

findByName name [] = Nothing
findByName name (found@(LabEquipment e c n):es) = 
    if n == name then Just found else findByName name es

addComponent component name [] = []
addComponent component name (e1@(LabEquipment e c n):es) = 
    if n == name then (LabEquipment e (component:c) n):es 
    else e1:addComponent component name es

l_rename :: Name -> Name -> [LabEquipment] -> [LabEquipment]
l_rename oldname newname [] = []
l_rename oldname newname (e1@(LabEquipment e c n):es) = 
    if n == oldname then (LabEquipment e c newname):es 
    else e1:l_rename oldname newname es



prettylog :: Log -> String
prettylog = concat.addFullStops
addFullStops :: [String] -> [String]
addFullStops = map (\s -> s++". ")