Thing.hs

{-# LANGUAGE 
        TemplateHaskell, 
        Arrows 
  #-}

module Thing where

import Prelude hiding (id, (.))

import Control.Arrow
import Control.Category

import Data.Lens.Strict
import Data.Lens.Template

infixl 0 <|
infixr 0 |>

-- f <| x == f x
-- x |> f == f x
(<|) =      ($)
(|>) = flip ($)

-- declaring operator priority for those functions in operator form, bla-bla-bla
infix 8 `get`, `set`, `modify`

get    = flip getL  -- object `get`    field
set    =      setL  -- field  `set`    value <| object
modify =      modL  -- field  `modify` fun   <| object

-- health bar, mana bar, etc
data Bar a = Bar 
    { _current :: a
    , _full    :: a
    }

-- "5 // 10" == Bar { _current = 5, _full = 10 }
(//) = Bar
    
-- toString
instance Show a => Show (Bar a) where
    show (Bar n f) = show n ++ "/" ++ show f

data Body = Body
    { _health :: Bar Int
    , _mana   :: Bar Int
    , _symbol :: String
    }
    deriving Show  -- automatic toString

-- make accessors ("lenses") from underscoped fields
$(makeLenses [''Bar, ''Body])

add =      (+)
sub = flip (-)  -- "sub 5" is a function, substracting five from its argument

-- no comments for this
cast :: Int -> (Body -> Body) 
cast manacost body =
    let 
        restMana      = body `get` current . mana
        manaAfterCast = restMana - manacost
        pranaDrain    = -manaAfterCast

    in  body
        |>  if   manaAfterCast < 0
            then id
                . (current . mana   `set`    0)
                . (current . health `modify` sub pranaDrain)

            else id
                . (current . mana   `set`    manaAfterCast)

-- a body to test magic
mage = Body 
    { _health = 10 // 10
    , _mana   = 10 // 20
    , _symbol = "@" 
    }

-- run ghci
-- type: 
--  :load Thing
--  mage
--  cast 5 mage
--  cast 10 mage
--  cast 11 mage