第20回オフラインリアルタイムどう書くの問題をHaskellで解く

http://nabetani.sakura.ne.jp/hena/ord20meetime/

間に合わなかったけど間に合った。。

```hs
import Data.List (splitAt, find)
import Data.List.Split (splitOn)

-- Test
import Test.Hspec (Spec, hspec, describe, it, shouldBe)
import Control.Monad (forM_)

type Time = Int
data Person = A | B | I | J | Z deriving (Eq, Show, Read)
type Schedule = (Time, Time)
type Booking = (Person, Schedule)

answer :: String -> String
answer cs = format $ bookableTime $ map bookFromString $ splitOn "," cs

format :: Maybe Time -> String
format (Just t) = stringFromTime t ++ "-" ++ stringFromTime (t+60)
format Nothing  = "-"

bookableTime :: [Booking] -> Maybe Time
bookableTime books = find (canStartFrom books) [10*60..17*60]

canStartFrom :: [Booking] -> Time -> Bool
canStartFrom books from =
  let schedule = (from, from+60)
  in meetsRequirement1 books schedule && meetsRequirement2 books schedule && meetsRequirement3 books schedule

bookFromString :: String -> Booking
bookFromString (person:cs) =
  let (from:to:[]) = splitOn "-" cs
  in  (read [person], (timeFromString from, timeFromString to))

timeFromString :: String -> Time
timeFromString xs =
  let (h,m) = splitAt 2 xs
  in  (read h * 60) + (read m)

stringFromTime :: Time -> String
stringFromTime t = concat $ map fixWidth [show (t `div` 60), show (t `mod` 60)] where
  fixWidth cs = replicate (2 - length cs) '0' ++ cs

-- TODO: 人物リストを渡して、全員参加しているかを確認する, attedsAll にする
meetsRequirement1 :: [Booking] -> Schedule -> Bool
meetsRequirement1 books schedule = (isAttendable A books schedule) && (isAttendable B books schedule)

-- TODO: 人物リストを渡して、だれか一人でも参加しているかを確認する, attendsAny にする
meetsRequirement2 :: [Booking] -> Schedule -> Bool
meetsRequirement2 books schedule = (isAttendable I books schedule) || (isAttendable J books schedule)

meetsRequirement3 :: [Booking] -> Schedule -> Bool
meetsRequirement3 books schedule =  (avoidsZamagawa Z books schedule)

-- TODO: 英語がおかしいので治す
isAttendable :: Person ->  [Booking] -> Schedule -> Bool
isAttendable person books schedule = not $ any ((intersects schedule) . snd) $ filter ((==person) . fst) books

avoidsZamagawa :: Person ->  [Booking] -> Schedule -> Bool
avoidsZamagawa person books schedule = any ((`contains` schedule) . snd) $ filter ((==person) . fst) books

-- (from, to) は from<=to である前提
intersects :: Schedule -> Schedule -> Bool
intersects (from,to) (from', to') = case compare from from' of
  LT -> from' < to
  EQ -> from' /= to'
  GT -> from < to'

contains :: Schedule -> Schedule -> Bool
contains (from,to) (from', to') = from <= from' && to' <= to

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "test" $ do
    forM_ tests $ \(n,input,expect) ->
      it (show n ++ ": " ++ input ++ " -> " ++ expect) $
        (answer input) `shouldBe` expect

tests :: [(Int,String,String)]
tests = [(0, "A1050-1130,B1400-1415,I1000-1400,I1600-1800,J1100-1745,Z1400-1421,Z1425-1800", "1425-1525")
        ,(1, "A1000-1200,B1300-1800,Z1000-1215,Z1230-1800", "-")
        ,(2, "Z0800-2200", "1000-1100")
        ,(3, "A1000-1700,Z0800-2200", "1700-1800")
        ,(4, "A1000-1701,Z0800-2200", "-")
        ,(5, "A1000-1130,B1230-1800,Z0800-2200", "1130-1230")
        ,(6, "A1000-1129,B1230-1800,Z0800-2200", "1129-1229")
        ,(7, "A1000-1131,B1230-1800,Z0800-2200", "-")
        ,(8, "A1000-1130,B1229-1800,Z0800-2200", "-")
        ,(9, "A1000-1130,B1231-1800,Z0800-2200", "1130-1230")
        ,(10,  "A1000-1130,B1230-1800,Z0800-1130,Z1131-2200", "-")
        ,(11,  "A1000-1130,B1231-1800,Z0800-1130,Z1131-2200", "1131-1231")
        ,(12,  "Z0800-0801", "-")
        ,(13,  "Z0800-1031,Z1129-1220,Z1315-1400,Z1459-1600", "1459-1559")
        ,(14,  "Z0800-2200,I1000-1600,J1030-1730", "1600-1700")
        ,(15,  "Z0800-2200,I1000-1600,J1130-1730", "1000-1100")
        ,(16,  "Z0800-2200,I1000-1600,J1130-1730,A0800-1025", "1025-1125")
        ,(17,  "Z0800-2200,I1000-1600,J1130-1730,A0800-1645", "1645-1745")
        ,(18,  "Z0800-2200,I1000-1600,J1130-1730,A0800-1645,I1735-2200", "-")
        ,(19,  "Z0800-2200,I1000-1600,J1130-1730,A0800-1645,J1735-2200", "1645-1745")
        ,(20,  "Z1030-2200,I1000-1600,J1130-1730", "1030-1130")
        ,(21,  "Z1035-1500,I1000-1600,J1130-1730,Z1644-2200", "1644-1744")
        ,(22,  "I2344-2350,A2016-2253,Z1246-1952", "1246-1346")
        ,(23,  "Z2155-2157,B1822-2032,Z1404-2000,Z2042-2147,Z2149-2154", "1404-1504")
        ,(24,  "Z2231-2250,Z2128-2219,B2219-2227,B2229-2230,Z0713-2121,A0825-1035,B1834-2001", "1035-1135")
        ,(25,  "J0807-1247,I0911-1414,B1004-1553,Z0626-1732,Z1830-1905,A1946-1954,A0623-1921", "-")
        ,(26,  "J1539-1733,J0633-1514,Z1831-1939,J1956-1959,I0817-1007,I1052-1524,Z1235-1756,Z0656-1144", "1524-1624")
        ,(27,  "Z2319-2350,B0833-2028,I2044-2222,A1410-2201,Z2044-2228,Z0830-2023,Z2242-2306,I2355-2359", "-")
        ,(28,  "B2001-2118,Z0712-1634,I1941-2102,B1436-1917", "1000-1100")
        ,(29,  "A0755-1417,B2303-2335,Z0854-2150,Z2348-2356,Z2156-2340,I1024-1307,Z2357-2359", "1417-1517")
        ,(30,  "A1958-1959,B0822-1155,I1518-1622,Z1406-1947,A1800-1822,A0904-1422,J1730-1924,Z1954-1958,A1946-1956", "1422-1522")
        ,(31,  "B1610-1910,I2121-2139,A0619-1412,I2147-2153,Z0602-2111,I0841-2031,A1657-1905,A1956-2047,J0959-1032,Z2131-2147", "1412-1512")
        ,(32,  "Z0623-1900,A0703-1129,I1815-1910,J1956-1957,I0844-1518,Z1902-1935,B1312-1342,J1817-1955", "1129-1229")
        ,(33,  "J1246-1328,B1323-1449,I1039-1746,Z1218-2111", "1449-1549")
        ,(34,  "A1958-1959,I1943-1944,I0731-1722,Z0845-1846,J1044-1513,Z1910-1923,B1216-1249", "1513-1613")
        ,(35,  "A1855-2047,Z0946-1849,Z2056-2059,I1855-1910,B1946-2058,I1956-2025,Z1905-2054,J0644-1800,I0720-1618", "1618-1718")
        ,(36,  "J1525-1950,Z0905-1933,A1648-1716,I2051-2054,I2015-2044,I0804-1958,B0934-1100,Z1953-2037", "1100-1200")
        ,(37,  "Z1914-1956,J0823-1610,Z0641-1841,J1800-1835,A0831-1346,I1926-1941,I1030-1558,I1738-1803", "1558-1658")
        ,(38,  "Z0625-1758,J1033-1351,B1816-2236,I0838-1615,J2247-2255", "1351-1451")
        ,(39,  "J0603-1233,A1059-1213,I1326-2103,Z0710-1459", "1213-1313")
        ,(40,  "B1302-1351,J1410-2038,A0755-1342,J0637-0658,Z2148-2159,Z1050-2131,A1543-1844,I1615-1810", "1351-1451")
        ,(41,  "Z0746-2100,A2122-2156,I1022-1144,J0947-1441,A1333-1949", "1144-1244")
        ,(42,  "J0718-1243,Z1443-1818,B2055-2057,A0714-1238,Z1045-1344,A1643-1717,B1832-2039,J1623-1931", "1238-1338")
        ,(43,  "Z1921-1933,A1208-1418,I0827-1940,Z0757-1917,J0653-1554,B1859-1909", "1554-1654")]

```

```

test
  - 0: A1050-1130,B1400-1415,I1000-1400,I1600-1800,J1100-1745,Z1400-1421,Z1425-1800 -> 1425-1525
  - 1: A1000-1200,B1300-1800,Z1000-1215,Z1230-1800 -> -
  - 2: Z0800-2200 -> 1000-1100
  - 3: A1000-1700,Z0800-2200 -> 1700-1800
  - 4: A1000-1701,Z0800-2200 -> -
  - 5: A1000-1130,B1230-1800,Z0800-2200 -> 1130-1230
  - 6: A1000-1129,B1230-1800,Z0800-2200 -> 1129-1229
  - 7: A1000-1131,B1230-1800,Z0800-2200 -> -
  - 8: A1000-1130,B1229-1800,Z0800-2200 -> -
  - 9: A1000-1130,B1231-1800,Z0800-2200 -> 1130-1230
  - 10: A1000-1130,B1230-1800,Z0800-1130,Z1131-2200 -> -
  - 11: A1000-1130,B1231-1800,Z0800-1130,Z1131-2200 -> 1131-1231
  - 12: Z0800-0801 -> -
  - 13: Z0800-1031,Z1129-1220,Z1315-1400,Z1459-1600 -> 1459-1559
  - 14: Z0800-2200,I1000-1600,J1030-1730 -> 1600-1700
  - 15: Z0800-2200,I1000-1600,J1130-1730 -> 1000-1100
  - 16: Z0800-2200,I1000-1600,J1130-1730,A0800-1025 -> 1025-1125
  - 17: Z0800-2200,I1000-1600,J1130-1730,A0800-1645 -> 1645-1745
  - 18: Z0800-2200,I1000-1600,J1130-1730,A0800-1645,I1735-2200 -> -
  - 19: Z0800-2200,I1000-1600,J1130-1730,A0800-1645,J1735-2200 -> 1645-1745
  - 20: Z1030-2200,I1000-1600,J1130-1730 -> 1030-1130
  - 21: Z1035-1500,I1000-1600,J1130-1730,Z1644-2200 -> 1644-1744
  - 22: I2344-2350,A2016-2253,Z1246-1952 -> 1246-1346
  - 23: Z2155-2157,B1822-2032,Z1404-2000,Z2042-2147,Z2149-2154 -> 1404-1504
  - 24: Z2231-2250,Z2128-2219,B2219-2227,B2229-2230,Z0713-2121,A0825-1035,B1834-2001 -> 1035-1135
  - 25: J0807-1247,I0911-1414,B1004-1553,Z0626-1732,Z1830-1905,A1946-1954,A0623-1921 -> -
  - 26: J1539-1733,J0633-1514,Z1831-1939,J1956-1959,I0817-1007,I1052-1524,Z1235-1756,Z0656-1144 -> 1524-1624
  - 27: Z2319-2350,B0833-2028,I2044-2222,A1410-2201,Z2044-2228,Z0830-2023,Z2242-2306,I2355-2359 -> -
  - 28: B2001-2118,Z0712-1634,I1941-2102,B1436-1917 -> 1000-1100
  - 29: A0755-1417,B2303-2335,Z0854-2150,Z2348-2356,Z2156-2340,I1024-1307,Z2357-2359 -> 1417-1517
  - 30: A1958-1959,B0822-1155,I1518-1622,Z1406-1947,A1800-1822,A0904-1422,J1730-1924,Z1954-1958,A1946-1956 -> 1422-1522
  - 31: B1610-1910,I2121-2139,A0619-1412,I2147-2153,Z0602-2111,I0841-2031,A1657-1905,A1956-2047,J0959-1032,Z2131-2147 -> 1412-1512
  - 32: Z0623-1900,A0703-1129,I1815-1910,J1956-1957,I0844-1518,Z1902-1935,B1312-1342,J1817-1955 -> 1129-1229
  - 33: J1246-1328,B1323-1449,I1039-1746,Z1218-2111 -> 1449-1549
  - 34: A1958-1959,I1943-1944,I0731-1722,Z0845-1846,J1044-1513,Z1910-1923,B1216-1249 -> 1513-1613
  - 35: A1855-2047,Z0946-1849,Z2056-2059,I1855-1910,B1946-2058,I1956-2025,Z1905-2054,J0644-1800,I0720-1618 -> 1618-1718
  - 36: J1525-1950,Z0905-1933,A1648-1716,I2051-2054,I2015-2044,I0804-1958,B0934-1100,Z1953-2037 -> 1100-1200
  - 37: Z1914-1956,J0823-1610,Z0641-1841,J1800-1835,A0831-1346,I1926-1941,I1030-1558,I1738-1803 -> 1558-1658
  - 38: Z0625-1758,J1033-1351,B1816-2236,I0838-1615,J2247-2255 -> 1351-1451
  - 39: J0603-1233,A1059-1213,I1326-2103,Z0710-1459 -> 1213-1313
  - 40: B1302-1351,J1410-2038,A0755-1342,J0637-0658,Z2148-2159,Z1050-2131,A1543-1844,I1615-1810 -> 1351-1451
  - 41: Z0746-2100,A2122-2156,I1022-1144,J0947-1441,A1333-1949 -> 1144-1244
  - 42: J0718-1243,Z1443-1818,B2055-2057,A0714-1238,Z1045-1344,A1643-1717,B1832-2039,J1623-1931 -> 1238-1338
  - 43: Z1921-1933,A1208-1418,I0827-1940,Z0757-1917,J0653-1554,B1859-1909 -> 1554-1654

Finished in 0.2089 seconds
44 examples, 0 failures
[Finished in 0.7s]
```