import Data.Functor.Identity
import Control.Applicative
import Control.Monad(liftM, MonadPlus(..), ap, join, replicateM)
import Control.Monad.Trans.Class
import Data.Foldable(traverse_)
import Data.IORef
import Control.Arrow((>>>),(***))
import Data.List(sortBy)

data FreeF f a b = Pure a | Free (f b)
  deriving (Eq,Ord,Show,Read)

instance Functor f => Functor (FreeF f a) where
  fmap _ (Pure a)  = Pure a
  fmap f (Free as) = Free (fmap f as)
  {-# INLINE fmap #-}

instance Foldable f => Foldable (FreeF f a) where
  foldMap f (Free as) = foldMap f as
  foldMap _ _         = mempty
  {-# INLINE foldMap #-}

instance Traversable f => Traversable (FreeF f a) where
  traverse _ (Pure a)  = pure (Pure a)
  traverse f (Free as) = Free <$> traverse f as
  {-# INLINE traverse #-}

newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) }

-- | The \"free monad\" for a functor @f@.
type Free f = FreeT f Identity

-- | Evaluates the first layer out of a free monad value.
runFree :: Free f a -> FreeF f a (Free f a)
runFree = runIdentity . runFreeT
{-# INLINE runFree #-}

free :: FreeF f a (Free f a) -> Free f a
free = FreeT . Identity
{-# INLINE free #-}

instance (Functor f, Monad m) => Functor (FreeT f m) where
  fmap f (FreeT m) = FreeT (liftM f' m) where
    f' (Pure a)  = Pure (f a)
    f' (Free as) = Free (fmap (fmap f) as)

instance (Functor f, Monad m) => Applicative (FreeT f m) where
  pure a = FreeT (return (Pure a))
  {-# INLINE pure #-}
  (<*>) = ap
  {-# INLINE (<*>) #-}

data StrIO n = GetLine (String -> n) | PutStrLn String n
  deriving (Functor)

type Action n = FreeT StrIO IO n

type RunMode a = Action a -> IO a

getString :: Action String
getString = liftF $ GetLine id

putString :: String -> Action ()
putString s = liftF $ PutStrLn s ()

stdIO :: Action a -> IO a
stdIO io = do
  iterT go io
  where
    go (PutStrLn s n) = putStrLn s >> n
    go (GetLine f)    = getLine >>= f

debugIO :: [String] -> Action a -> IO a
debugIO txt io = do
  que <- newQue txt
  iterT (go que) io
  where
    newQue = newIORef . cycle
    go _   (PutStrLn s n) = putStrLn s >> n
    go que (GetLine f)    = do
      txt <- popQue que
      f txt
      where
        popQue ref = atomicModifyIORef ref $ \(x:xs) -> (xs, x)

runAppOn :: RunMode a -> Action a -> IO a
runAppOn f = f

interactOn :: RunMode () -> (String -> String) -> IO ()
interactOn runner app = runner io
  where
    io = do
      s <- getString
      putString $ app s

debugInteraction :: (String -> String) -> [String] -> IO ()
debugInteraction app = traverse_ debugApp
  where
    debugApp x = interactOn (debugIO [x]) app

infixr 1 |>
(|>) :: a -> (a -> b) -> b
x |> f = f x

both :: (a -> b) -> (a,a) -> (b,b)
both f = f *** f

type SizeOfData = Int
type Weight = Int
type Value = Int

firstLine :: Action String -> Action (SizeOfData, Weight)
firstLine io = do
  s <- io
  s |> words >>> dblp >>> both read >>> return
    where
      dblp :: [a] -> (a,a)
      dblp xs = (xs !! 0, xs !! 1)

data Item = Item {
    value   :: Value
  , weight  :: Weight
} deriving (Show, Eq)

type Amount = Int

type Stock = (Item, Amount)

instance Ord Item where
  compare x y = compare (ratio x) (ratio y)
    where
      ratio i = (value i) `divf` (weight i)

stock :: (Int, Int, Int) -> Stock
stock (v, w, a) = (Item v w, a)

liftMap :: (Functor m1, Functor m2) => (a -> b) -> m1 (m2 a) -> m1 (m2 b)
liftMap f = fmap (fmap f)

divf :: Int -> Int -> Float
divf x y = x' / y'
  where
    x' = fromIntegral x
    y' = fromIntegral y

dataLine :: String -> Stock
dataLine s =
  s |> words >>> triple >>> each3 read >>> stock
    where
      triple :: [a] -> (a,a,a)
      triple xs = (xs !! 0, xs !! 1, xs !! 2)

      each3 :: (a -> b) -> (a,a,a) -> (b,b,b)
      each3 f (x,y,z) = (f x, f y, f z)

getData :: SizeOfData -> Action String -> Action [Stock]
getData n io = replicateM n (fmap dataLine io)

data Bag = Bag {
    sumValue  :: Value
  , current   :: Weight
  , maxWeight :: Weight
} deriving (Show, Eq)

newBag :: Weight -> Bag
newBag = Bag 0 0

capacity :: Bag -> Weight
capacity (Bag _ c m) = m - c

cannotStuff :: Stock -> Bag -> Bool
cannotStuff (i, _) b = capacity b < weight i

stuffSize :: Stock -> Bag -> Amount
stuffSize s@(i, a) b = if cannotStuff s b
  then 0
  else min a dv
    where
      dv = (capacity b) `div` (weight i)

stuff :: Stock -> Bag -> Bag
stuff stk@(item@(Item v w), _) bag@(Bag sv crt mw) =
  let sz = stuffSize stk bag in
    Bag (sv + v * sz) (crt + w * sz) mw

stuffAll :: [Stock] -> Bag -> Bag
stuffAll [] b = b
stuffAll (s:ss) b = if cannotStuff s b
  then stuffAll ss b
  else stuffAll ss $ stuff s b

sortValuable :: (Ord a) => [a] -> [a]
sortValuable = sortBy $ flip compare

app :: Action ()
app = do
  (size, maxWt) <- firstLine getString
  stocks <- getData size getString
  putString . show . sumValue $ stuffAll (sortValuable stocks) $ newBag maxWt

main :: IO ()
main = runOn stdIO app