Skip to content

Instantly share code, notes, and snippets.

@qnikst
Last active Aug 29, 2015
Embed
What would you like to do?
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Data.Aeson
import Data.Monoid
import Data.Maybe
data Quto = Quto (Maybe Int) (Maybe String) deriving Show
-- Парсер поддерживающий отсуствие значений
instance FromJSON Quto where
parseJSON = withObject "Quto" $ \v -> Quto <$> v .:? "value"
<*> v .:? "help"
-- Дефолтный конфиг (просто так)
defaultQuoto = Quto (Just 42) (Just "Pepi")
-- Средство объединения конфигов, работает как First
-- по каждому из полей
instance Monoid Quto where
mempty = Quto Nothing Nothing
Quto a1 b1 `mappend` Quto a2 b2 =
Quto (getFirst (First a1 <> First a2))
(getFirst (First b1 <> First b2))
-- Просто тестирование парсера
test1 :: Maybe Quto
test1 = decode "{\"value\":15}"
-- > Just (Quto (Just 15) Nothing)
test2 :: Maybe Quto
test2 = decode "{}"
-- > Just (Quto Nothing Nothing)
-- Дозаполнение структуры значениями по умолчанию:
test3 :: Maybe Quto
test3 = fmap (<> defaultQuoto) (decode "{}")
-- > Just (Quto (Just 42) (Just "Pepi"))
test4 :: Maybe Quto
test4 = fmap (<> defaultQuoto) (decode "{\"value\":666}")
-- > Just (Quto (Just 666) (Just "Pepi"))
-- Получение значений по умолчанию из окружения
test5 :: IO (Maybe Quto)
test5 = do
n <- getLine
return $ fmap (<> Quto (Just (read n)) (Just n)) (decode "{\"help\":\"kek\"}")
-- > Just (Quto (Just 5) (Just "kek")
test6 :: IO Quto
test6 = case decode "{\"help\":\"mok\"}" of
Nothing -> error ":("
Just x -> populate x
where
populate (Quto Nothing a) = populate =<< Quto <$> iAmIO 5 <*> pure a
populate (Quto a Nothing) = populate =<< Quto <$> pure a <*> iAmIO "yo!"
populate w = return w
iAmIO :: a -> IO (Maybe a)
iAmIO = return . Just
-- тоже самое можно и через case-
-- И наконец, если хочется показать, что в итоговой структуре невозможно
-- иметь Nothing, т.е. все значения заполнены, то предыдущую можно использовать
-- как прокси:
data Final = Final Int String
toFinal :: Quto -> IO Final
toFinal (Quto Nothing a) = toFinal =<< Quto <$> return (Just 7) <*> pure a -- или выкинуть ошибку
toFinal (Quto a Nothing) = toFinal =<< Quto <$> pure a <*> return (Just "s") -- или выкинуть ошибку
toFinal (Quto (Just a) (Just b)) = return $ Final a b
-- Можно всячески извращаься и обзединить Quto и Final
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment