{-# LANGUAGE TemplateHaskell #-} module Data.Aviation.Stratux.Types.IcaoAddr( IcaoAddr(..) , HasIcaoAddr(..) , HasWord8s(..) ) where import Control.Applicative(Applicative((<*>))) import Control.Category(Category(id)) import Control.Lens(makeClassy, Traversal') import Control.Monad(Monad(return)) import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Number), withScientific) import Data.Bits(shiftR, shiftL, (.|.), (.&.)) import Data.Eq(Eq) import Data.Functor((<$>)) import Data.Ord(Ord) import Data.Word(Word8, Word) import Prelude(floor, fromIntegral, Show, Num((*))) -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Lens -- >>> import Data.Aeson(decode, encode) -- >>> import Data.Maybe(Maybe) -- >>> import Prelude data IcaoAddr = IcaoAddr { _icaoAddrWord0 :: Word8 , _icaoAddrWord1 :: Word8 , _icaoAddrWord2 :: Word8 } deriving (Eq, Ord, Show) makeClassy ''IcaoAddr -- | -- -- >>> decode "8153826" :: Maybe IcaoAddr -- Just (IcaoAddr {_icaoAddrWord0 = 124, _icaoAddrWord1 = 106, _icaoAddrWord2 = 226}) -- -- >>> decode "66051" :: Maybe IcaoAddr -- Just (IcaoAddr {_icaoAddrWord0 = 1, _icaoAddrWord1 = 2, _icaoAddrWord2 = 3}) instance FromJSON IcaoAddr where parseJSON = withScientific "IcaoAddr" (\i -> let r :: Word r = floor i w n = fromIntegral (shiftR r (n * 8) .&. 255) in return (IcaoAddr (w 2) (w 1) (w 0))) -- | -- -- >>> encode (IcaoAddr 1 2 3) -- "66051" -- -- >>> encode (IcaoAddr 124 106 226) -- "8153826" instance ToJSON IcaoAddr where toJSON (IcaoAddr w0 w1 w2) = Number (fromIntegral (shiftL (shiftL (fromIntegral w0 :: Word) 8 .|. fromIntegral w1) 8 .|. fromIntegral w2)) -- | -- -- >>> _Word8s %~ (+1) $ IcaoAddr 124 106 226 -- IcaoAddr {_icaoAddrWord0 = 125, _icaoAddrWord1 = 107, _icaoAddrWord2 = 227} -- -- >>> _Word8s %~ (+1) $ IcaoAddr 1 2 3 -- IcaoAddr {_icaoAddrWord0 = 2, _icaoAddrWord1 = 3, _icaoAddrWord2 = 4} class HasWord8s a where _Word8s :: Traversal' a Word8 instance HasWord8s Word8 where _Word8s = id instance HasWord8s IcaoAddr where _Word8s f (IcaoAddr w0 w1 w2) = IcaoAddr <$> f w0 <*> f w1 <*> f w2