#!/usr/bin/env stack
{- stack script --resolver lts-16.31 --install-ghc
  --ghc-options -Wall --ghc-options -Wno-unused-imports --ghc-options -Wno-name-shadowing -}
{-# language NoImplicitPrelude #-}
{-# language RecordWildCards #-}
import Rebase.Prelude
import Control.Lens

import Data.Ratio
import Text.Printf

formatFeet :: RealFrac a => a -> String
formatFeet 0 = "0"
formatFeet l = unwords $ toList (feet f) ++ toList (inches i n d)
  where
    feet 0 = Nothing
    feet f = Just $ printf "%d'" f
    inches 0 0 _ = Nothing
    inches i 0 _ = Just $ printf "%d\"" i
    inches 0 n d = Just $ printf "%d/%d\"" n d
    inches i n d = Just $ printf "%d %d/%d\"" i n d

    n = numerator t
    d = denominator t
    (f, i, t) = toCarpenter l

    toCarpenter :: RealFrac a => a -> (Int, Int, Ratio Int)
    toCarpenter l = (feet, div r 32, mod r 32 % 32) where
        (feet, r) = divMod (round $ l * 32) (32 * 12)

type Inches = Rational

data Shelf = Shelf {
  boardLength :: Inches,
  boardThickness :: Inches,
  kickerHeight :: Inches,
  shelves :: [Integer]
}

bookshelf :: Shelf
bookshelf = Shelf {
  boardLength = 6 * 12,
  boardThickness = 5/8,
  kickerHeight = 4 + 1/2,
  shelves = [4, 4, 4, 3, 3]
}

roryShelf :: Shelf
roryShelf = Shelf {
  boardLength = 6 * 12,
  boardThickness = 5/8,
  kickerHeight = 4 + 1/2,
  shelves = [4, 4, 3, 3, 4]
}

pianoCubbies :: Shelf
pianoCubbies = Shelf {
  boardLength = 52 + 1%8,
  boardThickness = 5/8,
  kickerHeight = 0,
  shelves = [1, 1, 1, 1]
}

positions, positions' :: Shelf -> [Inches]
positions Shelf{..} = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelvesAbs
  where
    shelvesAbs = map (* availableSpace) shelves'
    shelves' = map (% (sum shelves)) shelves
    numHorizontals, numShelves :: Int
    numShelves = length shelves
    numHorizontals = numShelves + 1
    availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness

positions' x@Shelf{..} = map (boardLength -) $ positions x

printDadoMarkings :: Shelf -> IO ()
printDadoMarkings x = do
  if symmetrical
    then putStrLn "\nDado markings (symmetrical):\n"
    else putStrLn "\nDado markings:\n"

  mapM_ putStrLn $ formatFeet <$> positions x

  when (not symmetrical) $ do
    putStrLn "\nReversed:\n"
    mapM_ putStrLn $ formatFeet <$> positions' x
  where
    symmetrical = positions x == reverse (positions' x)

printCutlist :: Shelf -> IO ()
printCutlist x = do
  putStrLn "Length:"
  putStrLn $ formatFeet $ boardLength x
  printDadoMarkings x

printPianoCubbies :: IO ()
printPianoCubbies = do
  putStrLn "Piano Cubbies"
  putStrLn "-------------\n"
  printCutlist pianoCubbies

printRoryShelf :: IO ()
printRoryShelf = do
  putStrLn "Rory Shelf"
  putStrLn "----------\n"
  printCutlist roryShelf

main :: IO ()
main = printRoryShelf