From 3b57f59955968a3c3288ba3e8fb79114b78bc370 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Tue, 29 Dec 2020 14:56:54 -0500
Subject: fixed

---
 shelf.hs | 61 ++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 30 insertions(+), 31 deletions(-)

diff --git a/shelf.hs b/shelf.hs
index 61710e8..8389d63 100755
--- a/shelf.hs
+++ b/shelf.hs
@@ -1,6 +1,6 @@
 #!/usr/bin/env stack
 {- stack script --resolver lts-16.27 --install-ghc
-  --ghc-options -Wall --ghc-options -Wno-unused-imports -}
+  --ghc-options -Wall --ghc-options -Wno-unused-imports --ghc-options -Wno-name-shadowing -}
 {-# language NoImplicitPrelude #-}
 {-# language DuplicateRecordFields #-}
 import Rebase.Prelude
@@ -9,50 +9,49 @@ import Control.Lens
 import Data.Ratio
 import Text.Printf
 
-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)
-
-feetAndInches :: RealFrac a => a -> String
-feetAndInches l = case toCarpenter l of
-    (0,0,0) -> "0 feet 0 inches"
-    (f,i,t) -> showUnit "foot" "feet" (f % 1) ++
-                (if f > 0 && (i%1 + t) > 0 then " " else "") ++
-                showUnit "inch" "inches" (i % 1 + t)
-    where
-    showUnit _ _ 0 = ""
-    showUnit s m n = printf "%s %s" (showVal n) $ if n <= 1 then s else m
-    showVal v | d == 1    = show n
-              | v < 1     = printf "%d/%d" n d
-              | otherwise = printf "%d and %d/%d" (div n d) (mod n d) d
-              where (n,d) = (numerator v, denominator v)
+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
 
-boardLength, boardThickness, kickerHeight, numShelves, numHorizontals, availableSpace :: Inches
+boardLength, boardThickness, kickerHeight, availableSpace :: Inches
 boardLength = 6 * 12
 boardThickness = 5/8
 kickerHeight = 4
-numShelves = 5
+numHorizontals, numShelves :: Int
+numShelves = length shelves
 
 numHorizontals = numShelves + 1
-availableSpace = boardLength - kickerHeight - numHorizontals * boardThickness
+availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness
 
 shelves :: [Rational]
-shelves = kickerHeight : map (* availableSpace) [2%9, 2%9, 2%9, 1%6, 1%6]
+shelves = map (* availableSpace) [2%9, 2%9, 2%9, 1%6, 1%6]
 
-positions :: [Inches]
-positions = map (+ boardThickness) $ map sum $ tails shelves
+positions, positions' :: [Inches]
+positions = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelves
 
 positions' = map (boardLength -) positions
 
 main :: IO ()
 main = do
-  _ <- return $ assert $ sum shelves == 1
-  print shelves
-  print positions
-  print $ map (fromRational :: Rational -> Float) positions
-  print positions'
-  print $ map (fromRational :: Rational -> Float) positions'
-  mapM_ putStrLn $ feetAndInches <$> positions'
+  void $ return $ assert $ sum shelves == 1
+  mapM_ putStrLn $ formatFeet <$> positions
+  putStrLn ""
+  mapM_ putStrLn $ formatFeet <$> positions'
   return ()
-- 
cgit v1.2.3