Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
134 lines (111 sloc) 4.16 KB
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module TourJson where
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Time.Calendar (Day)
import Data.Time.Format (parseTimeM, defaultTimeLocale, formatTime, iso8601DateFormat)
import Data.Time.LocalTime (LocalTime, TimeOfDay)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.Clock (NominalDiffTime)
import Data.Map (Map, fromList)
import Data.Maybe (catMaybes)
import Data.List (intercalate)
import Data.Aeson
import Data.Aeson.Types
import Data.Monoid
import Control.Monad (forM)
import Data.Text (Text)
import GHC.Generics
import qualified Data.Map as M
import qualified Data.Vector as V
import Naqsha.Geometry
import Data.Scientific (toRealFloat)
import Network.URI (URI(..), parseURIReference)
import Types
prefixOptions :: Options
prefixOptions = defaultOptions { fieldLabelModifier = drop 1 . dropWhile (/= '_') . camel }
instance ToJSON TourDay where
toJSON = genericToJSON prefixOptions
instance ToJSON Tour where
toJSON = genericToJSON prefixOptions
instance ToJSON Geo where
toJSON (Geo lat' lon') = Array (V.fromList [num lat', num lon'])
where
num :: Angular n => n -> Value
num = Number . toDegree . toAngle
instance FromJSON Tour where
parseJSON (Object v) = Tour <$>
v .: "name" <*>
v .:? "description" .!= "" <*>
v .:? "days" .!= [] <*>
v .:? "start_date" <*>
v .:? "end_date" <*>
v .:? "countries" .!= []
-- A non-Object value is of the wrong type, so fail.
parseJSON _ = mempty
instance FromJSON TourDay where
parseJSON (Object v) = TourDay <$>
v .:? "num" .!= 0 <*>
v .: "date" <*>
v .:? "start" <*>
v .:? "end" <*>
v .:? "from" .!= "" <*>
v .:? "to" .!= "" <*>
v .:? "from_coord" <*>
v .:? "to_coord" <*>
v .:? "dist" .!= 0 <*>
v .:? "blog"
parseJSON (String d) = do
d' <- parseJSON (String d)
return $ TourDay 0 d' Nothing Nothing "" "" Nothing Nothing 0 Nothing
-- A non-Object value is of the wrong type, so fail.
parseJSON v = typeMismatch "TourDay" v
instance FromJSON Geo where
parseJSON (Object v) = Geo <$> v .: "lat" <*> v .: "lng"
parseJSON (Array a) = case V.toList a of
[lat', lon'] -> Geo <$> parseJSON lat' <*> parseJSON lon'
_ -> fail "expected length 2 array"
parseJSON v = typeMismatch "Geo" v
parseCoord :: (Angle -> a) -> Value -> Parser a
parseCoord coord (Number n) = pure . coord . degree . toRational . toRealFloat $ n
parseCoord _ v = typeMismatch "Angle" v
instance FromJSON Latitude where
parseJSON = parseCoord lat
instance FromJSON Longitude where
parseJSON = parseCoord lon
instance ToJSON ElevPoint where
toJSON (ElevPoint e s t) = object ["ele" .= e, "dist" .= s, "time" .= t]
instance FromJSON ElevPoint where
parseJSON (Object v) = ElevPoint
<$> v .: "ele"
<*> v .: "dist"
<*> v .: "time"
parseJSON v = typeMismatch "ElevPoint" v
instance ToJSON URI where
toJSON = String . T.pack . show
instance FromJSON URI where
parseJSON (String u) = case parseURIReference (T.unpack u) of
Just uri -> pure uri
Nothing -> fail "Not a valid URI"
----------------------------------------------------------------------------
#if !MIN_VERSION_aeson(1,0,0)
instance ToJSON Day where
toJSON _ = object []
instance ToJSON TimeOfDay where
toJSON _ = object []
instance ToJSON NominalDiffTime where
toJSON _ = object []
instance FromJSON Day where
parseJSON _ = undefined
instance FromJSON TimeOfDay where
parseJSON _ = undefined
instance FromJSON NominalDiffTime where
parseJSON _ = undefined
camel = camelTo '_'
#else
camel = camelTo2 '_'
#endif