{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Faker.Provider.Compass where import Config import Control.Monad.Catch import Control.Monad.IO.Class import Data.Map.Strict (Map) import Data.Monoid ((<>)) import Data.Text (Text) import Data.Vector (Vector) import Data.Yaml import Faker import Faker.Internal import Faker.Provider.TH import Language.Haskell.TH parseCompass :: FromJSON a => FakerSettings -> Value -> Parser a parseCompass settings (Object obj) = do en <- obj .: (getLocale settings) faker <- en .: "faker" compass <- faker .: "compass" pure compass parseCompass settings val = fail $ "expected Object, but got " <> (show val) parseCompassField :: (FromJSON a, Monoid a) => FakerSettings -> Text -> Value -> Parser a parseCompassField settings txt val = do compass <- parseCompass settings val field <- compass .:? txt .!= mempty pure field parseCompassFields :: (FromJSON a, Monoid a) => FakerSettings -> [Text] -> Value -> Parser a parseCompassFields settings txts val = do compass <- parseCompass settings val helper compass txts where helper :: (FromJSON a) => Value -> [Text] -> Parser a helper a [] = parseJSON a helper (Object a) (x:xs) = do field <- a .: x helper field xs helper a (x:xs) = fail $ "expect Object, but got " <> (show a) parseUnresolvedCompassField :: (FromJSON a, Monoid a) => FakerSettings -> Text -> Value -> Parser (Unresolved a) parseUnresolvedCompassField settings txt val = do compass <- parseCompass settings val field <- compass .:? txt .!= mempty pure $ pure field $(genParserUnresolved "compass" "direction") $(genProviderUnresolved "compass" "direction") $(genParserUnresolved "compass" "abbreviation") $(genProviderUnresolved "compass" "abbreviation") $(genParserUnresolved "compass" "azimuth") $(genProviderUnresolved "compass" "azimuth") $(genParsers "compass" ["cardinal", "word"]) $(genProviders "compass" ["cardinal", "word"]) $(genParsers "compass" ["cardinal", "abbreviation"]) $(genProviders "compass" ["cardinal", "abbreviation"]) $(genParsers "compass" ["cardinal", "azimuth"]) $(genProviders "compass" ["cardinal", "azimuth"]) $(genParsers "compass" ["ordinal", "word"]) $(genProviders "compass" ["ordinal", "word"]) $(genParsers "compass" ["ordinal", "abbreviation"]) $(genProviders "compass" ["ordinal", "abbreviation"]) $(genParsers "compass" ["ordinal", "azimuth"]) $(genProviders "compass" ["ordinal", "azimuth"]) $(genParsers "compass" ["half-wind", "word"]) $(genProviders "compass" ["half-wind", "word"]) $(genParsers "compass" ["half-wind", "abbreviation"]) $(genProviders "compass" ["half-wind", "abbreviation"]) $(genParsers "compass" ["half-wind", "azimuth"]) $(genProviders "compass" ["half-wind", "azimuth"]) $(genParsers "compass" ["quarter-wind", "word"]) $(genProviders "compass" ["quarter-wind", "word"]) $(genParsers "compass" ["quarter-wind", "abbreviation"]) $(genProviders "compass" ["quarter-wind", "abbreviation"]) $(genParsers "compass" ["quarter-wind", "azimuth"]) $(genProviders "compass" ["quarter-wind", "azimuth"]) resolveCompassText :: (MonadIO m, MonadThrow m) => FakerSettings -> Text -> m Text resolveCompassText = genericResolver' resolveCompassField cardinalProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text) cardinalProvider settings = do cw <- compassCardinalWordProvider settings ca <- compassCardinalAbbreviationProvider settings caz <- compassCardinalAzimuthProvider settings pure $ cw <> ca <> caz ordinalProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text) ordinalProvider settings = do cw <- compassOrdinalWordProvider settings ca <- compassOrdinalAbbreviationProvider settings caz <- compassOrdinalAzimuthProvider settings pure $ cw <> ca <> caz halfWindProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text) halfWindProvider settings = do cw <- compassHalfWindWordProvider settings ca <- compassHalfWindAbbreviationProvider settings caz <- compassHalfWindAzimuthProvider settings pure $ cw <> ca <> caz quarterWindProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text) quarterWindProvider settings = do cw <- compassQuarterWindWordProvider settings ca <- compassQuarterWindAbbreviationProvider settings caz <- compassQuarterWindAzimuthProvider settings pure $ cw <> ca <> caz abbreviationProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text) abbreviationProvider settings = do cw <- compassCardinalAbbreviationProvider settings ca <- compassOrdinalAbbreviationProvider settings caz <- compassHalfWindAbbreviationProvider settings qw <- compassQuarterWindAbbreviationProvider settings pure $ cw <> ca <> caz <> qw resolveCompassField :: (MonadThrow m, MonadIO m) => FakerSettings -> Text -> m Text resolveCompassField settings field@"cardinal" = cachedRandomVec "compass" field cardinalProvider settings resolveCompassField settings field@"ordinal" = cachedRandomVec "compass" field ordinalProvider settings resolveCompassField settings field@"half_wind" = cachedRandomVec "compass" field halfWindProvider settings resolveCompassField settings field@"quarter_wind" = cachedRandomVec "compass" field quarterWindProvider settings resolveCompassField settings field@"cardinal_abbreviation" = cachedRandomVec "compass" field compassCardinalAbbreviationProvider settings resolveCompassField settings field@"ordinal_abbreviation" = cachedRandomVec "compass" field compassOrdinalAbbreviationProvider settings resolveCompassField settings field@"half_wind_abbreviation" = cachedRandomVec "compass" field compassHalfWindAbbreviationProvider settings resolveCompassField settings field@"quarter_wind_abbreviation" = cachedRandomVec "compass" field compassQuarterWindAbbreviationProvider settings resolveCompassField settings field@"cardinal_azimuth" = cachedRandomVec "compass" field compassCardinalAzimuthProvider settings resolveCompassField settings field@"ordinal_azimuth" = cachedRandomVec "compass" field compassOrdinalAzimuthProvider settings resolveCompassField settings field@"half_wind_azimuth" = cachedRandomVec "compass" field compassHalfWindAzimuthProvider settings resolveCompassField settings field@"quarter_wind_azimuth" = cachedRandomVec "compass" field compassQuarterWindAzimuthProvider settings resolveCompassField settings field@"direction" = cachedRandomUnresolvedVec "compass" field compassDirectionProvider resolveCompassText settings resolveCompassField settings field@"abbreviation" = cachedRandomUnresolvedVec "compass" field compassAbbreviationProvider resolveCompassText settings resolveCompassField settings field@"azimuth" = cachedRandomUnresolvedVec "compass" field compassAzimuthProvider resolveCompassText settings resolveCompassField settings str = throwM $ InvalidField "compass" str