Skip to content

Commit 7513c9d

Browse files
haskie-lambdahaskie-lambda
committed
added fourth problem; solved bug in splitOn function; added lib for convenience functions
1 parent e1854a6 commit 7513c9d

File tree

4 files changed

+1290
-13
lines changed

4 files changed

+1290
-13
lines changed

‎2.hs

+2-13
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,10 @@
11
{-# LANGUAGE TypeApplications #-}
22
{-# LANGUAGE BangPatterns #-}
3+
34
import System.IO.Unsafe
45
import Control.Exception
56
import Data.Maybe
7+
import Lib
68

79
dummyData = [ "1-3 a: abcde"
810
, "1-3 b: cdefg"
@@ -55,16 +57,3 @@ parsePassword passFunc str = let (strSpec:strPass:_) = str `splitOn` ": "
5557
spec = toSpec strSpec
5658
in (passFunc strPass) =<< spec
5759

58-
splitOn :: (Eq a) => [a] -> [a] -> [[a]]
59-
splitOn str [] = [str]
60-
splitOn str stop = reverse $ go str stop id
61-
where
62-
go :: Eq a => [a] -> [a] -> ([[a]] -> [[a]]) -> [[a]]
63-
go [] _ f = f []
64-
go str stop f = let (evtl, rest) = break (== (head stop)) str
65-
in if take (length stop) rest == stop
66-
then go (drop (length stop) rest) stop $ (([]:) . (addToHead evtl) . f)
67-
else go (drop 1 rest) stop $ (addToHead (evtl) . f)
68-
where addToHead :: [a] -> [[a]] -> [[a]]
69-
addToHead a [] = [a]
70-
addToHead a (as:r) = (a ++ as):r

‎4.hs

+151
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,151 @@
1+
{-# LANGUAGE BangPatterns #-}
2+
{-# LANGUAGE TypeApplications #-}
3+
{-# LANGUAGE ScopedTypeVariables#-}
4+
{-# LANGUAGE DeriveAnyClass #-}
5+
{-# LANGUAGE DeriveGeneric #-}
6+
import Lib
7+
import Control.DeepSeq
8+
import GHC.Generics
9+
import Control.Exception
10+
import System.IO.Unsafe
11+
import Data.Maybe
12+
import Data.List
13+
import Data.Char
14+
import Debug.Trace
15+
16+
dummyInput = unlines $ [ "ecl:gry pid:860033327 eyr:2020 hcl:#fffffd"
17+
, "byr:1937 iyr:2017 cid:147 hgt:183cm"
18+
, ""
19+
, "iyr:2013 ecl:amb cid:350 eyr:2023 pid:028048884"
20+
, "hcl:#cfa07d byr:1929"
21+
, ""
22+
, "hcl:#ae17e1 iyr:2013"
23+
, "eyr:2024"
24+
, "ecl:brn pid:760753108 byr:1931"
25+
, "hgt:179cm"
26+
, ""
27+
, "hcl:#cfa07d eyr:2025 pid:166559648"
28+
, "iyr:2011 ecl:brn hgt:59in" ]
29+
30+
dummyInvalid = unlines $ ["eyr:1972 cid:100"
31+
, "hcl:#18171d ecl:amb hgt:170 pid:186cm iyr:2018 byr:1926"
32+
, ""
33+
, "iyr:2019"
34+
, "hcl:#602927 eyr:1967 hgt:170cm"
35+
, "ecl:grn pid:012533040 byr:1946"
36+
, ""
37+
, "hcl:dab227 iyr:2012"
38+
, "ecl:brn hgt:182cm pid:021572410 eyr:2020 byr:1992 cid:277"
39+
, ""
40+
, "hgt:59cm ecl:zzz"
41+
, "eyr:2038 hcl:74454a iyr:2023"
42+
, "pid:3556412378 byr:2007"]
43+
44+
dummyValid = unlines $ [ "pid:087499704 hgt:74in ecl:grn iyr:2012 eyr:2030 byr:1980"
45+
, "hcl:#623a2f"
46+
, ""
47+
, "eyr:2029 ecl:blu cid:129 byr:1989"
48+
, "iyr:2014 pid:896056539 hcl:#a97842 hgt:165cm"
49+
, ""
50+
, "hcl:#888785"
51+
, "hgt:164cm byr:2001 iyr:2015 cid:88"
52+
, "pid:545766238 ecl:hzl"
53+
, "eyr:2022"
54+
, ""
55+
, "iyr:2010 hgt:158cm hcl:#b6652a ecl:blu byr:1944 eyr:2021 pid:093154719"]
56+
57+
58+
main = do
59+
let toStrings s = map (cReplace '\n' ' ') $ s `splitOn` "\n\n"
60+
putStrLn $ "correct from dummy input: " ++
61+
(show $ length $ filter isJust $ map parsePassport (toStrings dummyInput))
62+
contents <- readFile "4.input"
63+
putStrLn $ "correct from file: " ++
64+
(show $ length $ filter isJust $ map parsePassport (toStrings contents))
65+
66+
putStrLn $ "all invalid invalid: " ++
67+
(show $ all (not . isJust) $ map parsePassport (toStrings dummyInvalid))
68+
putStrLn $ "all valid valid: " ++
69+
(show $ all (isJust) $ map parsePassport (toStrings dummyValid))
70+
71+
data Measure = CM | IN deriving (Read, Show, Generic)
72+
data EyeColor = AMB | BLU | BRN | GRY | GRN | HZL | OTH deriving (Read, Show, Generic)
73+
74+
instance NFData Measure
75+
instance NFData EyeColor
76+
77+
data Passport = Passport { ecl :: !EyeColor
78+
, pid :: !String
79+
, eyr :: !Int
80+
, hcl :: !String
81+
, byr :: !Int
82+
, iyr :: !Int
83+
, cid :: !(Maybe Int)
84+
, hgt :: !(Int, Measure)}
85+
deriving Show
86+
87+
-- parses a space ' ' delimited list of key value pairs
88+
parsePassport :: String -> Maybe Passport
89+
parsePassport s = let listPairs :: [[String]]
90+
listPairs = (map (`splitOn` ":")) . (`splitOn` " ") $ s
91+
pairs :: [(String, String)]
92+
pairs = strictMap (\(a:b:_) -> ((,) $! a) $! b)
93+
$ filter ((==2) .length) listPairs
94+
pass :: [(String, String)] -> Maybe Passport
95+
pass pairs = let
96+
ecl' = (tryParse @EyeColor . map toUpper)
97+
=<< getFromMap "ecl" pairs
98+
pid' = getFromMap "pid" pairs
99+
eyr' = tryParse @Int =<< getFromMap "eyr" pairs
100+
hcl' = getFromMap "hcl" pairs
101+
byr' :: Maybe Int
102+
byr' = tryParse @Int =<< getFromMap "byr" pairs
103+
iyr' = tryParse @Int =<< getFromMap "iyr" pairs
104+
cid' = return $ tryParse @Int =<< getFromMap "cid" pairs
105+
hgt' = (\s -> let m = map toUpper
106+
. reverse
107+
. take 2
108+
. reverse $ s
109+
me = tryParse @Measure m
110+
num = reverse . drop 2 . reverse $ s
111+
nnum = tryParse @Int num
112+
in (,) <$> nnum <*> me
113+
) =<< getFromMap "hgt" pairs
114+
checks :: [Maybe Bool]
115+
checks = [fmap (btwIncl 1920 2002) byr'
116+
,fmap (btwIncl 2010 2020) iyr'
117+
,fmap (btwIncl 2020 2030) eyr'
118+
,fmap ((\h -> length h == 7
119+
&& head h == '#'
120+
&& ((==6)
121+
. length
122+
. filter (`elem` "0123456789abcdef")
123+
$ h))
124+
) hcl'
125+
,fmap ((\n -> length n == 9
126+
&& all (`elem` "0123456789") n))
127+
pid'
128+
,fmap (\(i,m) -> case m of
129+
CM -> btwIncl 150 193 i
130+
IN -> btwIncl 59 76 i)
131+
hgt']
132+
create =
133+
if all (==Just True) checks
134+
then Just Passport
135+
else Nothing
136+
in create <*> ecl' <*> pid' <*> eyr' <*> hcl'
137+
<*> byr' <*> iyr' <*> cid' <*> hgt'
138+
in pass pairs
139+
140+
btwIncl :: Ord a => a -> a -> a -> Bool
141+
btwIncl l u a = a >= l && a <= u
142+
143+
getFromMap :: Eq a => a -> [(a, b)] -> Maybe b
144+
getFromMap _ [] = Nothing
145+
getFromMap a ((a',b):as)
146+
| a == a' = Just $ b `seq` b
147+
| otherwise = getFromMap a as
148+
149+
strictMap :: (a -> b) -> [a] -> [b]
150+
strictMap f [] = []
151+
strictMap f (a:as) = (f $! a) : (strictMap f as)

0 commit comments

Comments
 (0)