{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TemplateHaskell #-}

module Data.Aviation.Casr.Logbook.Meta.Video(
  Video(Video)
, HasVideo(..)
, videoUriType
, videosource'
, videoname'
) where

import Control.Category
import Control.Lens(makeClassy, Traversal', _Just)
import Data.Aviation.Casr.Logbook.Meta.VideoType ( VideoType )
import Data.Eq(Eq)
import Data.Maybe(Maybe(..))
import Data.Ord(Ord)
import Data.String(String)
import Prelude(Show)

data Video =
  Video {
    Video -> String
_videouri :: String
  , Video -> VideoType
_videotype :: VideoType
  , Video -> Maybe String
_videosource :: Maybe String
  , Video -> Maybe String
_videoname :: Maybe String
  } deriving (Video -> Video -> Bool
(Video -> Video -> Bool) -> (Video -> Video -> Bool) -> Eq Video
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Video -> Video -> Bool
== :: Video -> Video -> Bool
$c/= :: Video -> Video -> Bool
/= :: Video -> Video -> Bool
Eq, Eq Video
Eq Video =>
(Video -> Video -> Ordering)
-> (Video -> Video -> Bool)
-> (Video -> Video -> Bool)
-> (Video -> Video -> Bool)
-> (Video -> Video -> Bool)
-> (Video -> Video -> Video)
-> (Video -> Video -> Video)
-> Ord Video
Video -> Video -> Bool
Video -> Video -> Ordering
Video -> Video -> Video
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Video -> Video -> Ordering
compare :: Video -> Video -> Ordering
$c< :: Video -> Video -> Bool
< :: Video -> Video -> Bool
$c<= :: Video -> Video -> Bool
<= :: Video -> Video -> Bool
$c> :: Video -> Video -> Bool
> :: Video -> Video -> Bool
$c>= :: Video -> Video -> Bool
>= :: Video -> Video -> Bool
$cmax :: Video -> Video -> Video
max :: Video -> Video -> Video
$cmin :: Video -> Video -> Video
min :: Video -> Video -> Video
Ord, Int -> Video -> ShowS
[Video] -> ShowS
Video -> String
(Int -> Video -> ShowS)
-> (Video -> String) -> ([Video] -> ShowS) -> Show Video
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Video -> ShowS
showsPrec :: Int -> Video -> ShowS
$cshow :: Video -> String
show :: Video -> String
$cshowList :: [Video] -> ShowS
showList :: [Video] -> ShowS
Show)

makeClassy ''Video

videoUriType ::
  String
  -> VideoType
  -> Video
videoUriType :: String -> VideoType -> Video
videoUriType String
s VideoType
t =
  String -> VideoType -> Maybe String -> Maybe String -> Video
Video String
s VideoType
t Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

videosource' ::
  HasVideo c =>
  Traversal' c String
videosource' :: forall c. HasVideo c => Traversal' c String
videosource' =
  (Maybe String -> f (Maybe String)) -> c -> f c
forall c. HasVideo c => Lens' c (Maybe String)
Lens' c (Maybe String)
videosource ((Maybe String -> f (Maybe String)) -> c -> f c)
-> ((String -> f String) -> Maybe String -> f (Maybe String))
-> (String -> f String)
-> c
-> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> Maybe String -> f (Maybe String)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just

videoname' ::
  HasVideo c =>
  Traversal' c String
videoname' :: forall c. HasVideo c => Traversal' c String
videoname' =
  (Maybe String -> f (Maybe String)) -> c -> f c
forall c. HasVideo c => Lens' c (Maybe String)
Lens' c (Maybe String)
videoname ((Maybe String -> f (Maybe String)) -> c -> f c)
-> ((String -> f String) -> Maybe String -> f (Maybe String))
-> (String -> f String)
-> c
-> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> f String) -> Maybe String -> f (Maybe String)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just