# LANGUAGE DuplicateRecordFields #

| 
 Module       : Flight . Track . Mask 
 Copyright    : ( c ) Block Scope Limited 2017 
 License      : MPL-2.0 
 Maintainer   :  
 Stability    : experimental 

 Tracks masked with task control zones . 

Module      : Flight.Track.Mask
Copyright   : (c) Block Scope Limited 2017
License     : MPL-2.0
Maintainer  : 
Stability   : experimental

Tracks masked with task control zones.
-}
module Flight.Track.Land
    ( TaskLanding(..)
    , CompLanding(..)
    , TrackEffort(..)
    , effortRank
    , mkCompLandOut, unMkCompLandOut, taskLanding
    ) where

import Lens.Micro ((^?), ix)
import Data.List (sortOn, unzip5)
import Data.String (IsString())
import GHC.Generics (Generic)
import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.UnitsOfMeasure (u, convert)
import Data.UnitsOfMeasure.Internal (Quantity(..))

import Flight.Field (FieldOrdering(..))
import Flight.Distance (QTaskDistance, TaskDistance(..))
import "flight-gap-allot" Flight.Score ( Pilot(..), PilotDistance(..), FlownMax(..))
import "flight-gap-effort" Flight.Score
    ( Lookahead
    , Chunking(..)
    , ChunkDifficulty(..)
    , DifficultyFraction(..)
    )
import Flight.Comp (IxTask(..))
import Flight.Track.Curry (uncurry5)

data TrackEffort =
    TrackEffort
        { effort :: QTaskDistance Double [u| m |]
        , frac :: DifficultyFraction
        -- ^ This is a fraction of the possible effort points, not of the
        -- possible distance points.
        }
    deriving (Eq, Ord, Show, Generic)
    deriving anyclass (FromJSON, ToJSON)

chunkEffort :: ChunkDifficulty -> [(Pilot, TrackEffort)]
chunkEffort ChunkDifficulty{downs, downers, frac = DifficultyFraction df} =
    [
        ( pilot
        , TrackEffort
            { effort = TaskDistance $ convert d
  NOTE : Make maximum track effort unit , 1 . Difficulty points are
  half of the distance points so we need to double the fraction .
            , frac = DifficultyFraction $ 2 * df
            }
        )
    | PilotDistance d <- downs
    | pilot <- downers
    ]

effortRank :: CompLanding -> [[(Pilot, TrackEffort)]]
effortRank CompLanding{difficulty} =
    [ maybe
        []
        ( sortOn
            ( (\TrackEffort{frac = DifficultyFraction x} -> negate x)
            . snd
            )
        . concatMap chunkEffort
        )
        d
    | d <- difficulty
    ]

-- | The landing for a single task.
data TaskLanding =
    TaskLanding
        { bestDistance :: Maybe (FlownMax (Quantity Double [u| km |]))
        -- ^ The best distance flown.
        , landout :: Int
        -- ^ The number of pilots landing out.
        , lookahead :: Maybe Lookahead
        -- ^ How many 100m chunks to look ahead for land outs.
        , chunking :: Maybe Chunking
        -- ^ The chunking.
        , difficulty :: Maybe [ChunkDifficulty]
        -- ^ The difficulty of each chunk.
        }
    deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)

-- | For each task, the landing for that task.
data CompLanding =
    CompLanding
        { bestDistance :: [Maybe (FlownMax (Quantity Double [u| km |]))]
        -- ^ For each task, the best distance flown.
        , landout :: [Int]
        -- ^ For each task, the number of pilots landing out.
        , lookahead :: [Maybe Lookahead]
  ^ For each task , how many 100 m chunks to look ahead for land outs .
        , chunking :: [Maybe Chunking]
        -- ^ For each task, the chunking.
        , difficulty :: [Maybe [ChunkDifficulty]]
        -- ^ The difficulty of each chunk.
        }
    deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)

mkCompLandOut :: [TaskLanding] -> CompLanding
mkCompLandOut ts =
    uncurry5 CompLanding $ unzip5
    [ (a, b, c, d, e)
    | TaskLanding
        { bestDistance = a
        , landout = b
        , lookahead = c
        , chunking = d
        , difficulty = e
        } <- ts
    ]

unMkCompLandOut :: CompLanding -> [TaskLanding]
unMkCompLandOut
    CompLanding
        { bestDistance = as
        , landout = bs
        , lookahead = cs
        , chunking = ds
        , difficulty = es
        } =
    [ TaskLanding a b c d e
    | a <- as
    | b <- bs
    | c <- cs
    | d <- ds
    | e <- es
    ]

taskLanding :: IxTask -> CompLanding -> Maybe TaskLanding
taskLanding (IxTask iTask) CompLanding{..} = do
    let i = fromIntegral iTask - 1
    bd <- bestDistance ^? ix i
    lo <- landout ^? ix i
    la <- lookahead ^? ix i
    cg <- chunking ^? ix i
    df <- difficulty ^? ix i
    return
        TaskLanding
            { bestDistance = bd
            , landout = lo
            , lookahead = la
            , chunking = cg
            , difficulty = df
            }

instance FieldOrdering TaskLanding where fieldOrder _ = cmp
instance FieldOrdering CompLanding where fieldOrder _ = cmp

cmp :: (Ord a, IsString a) => a -> a -> Ordering
cmp a b =
    case (a, b) of
        ("chunk", _) -> LT

        ("startChunk", "chunk") -> GT
        ("startChunk", _) -> LT

        ("endChunk", "chunk") -> GT
        ("endChunk", "startChunk") -> GT
        ("endChunk", _) -> LT

        ("endAhead", "chunk") -> GT
        ("endAhead", "startChunk") -> GT
        ("endAhead", "endChunk") -> GT
        ("endAhead", _) -> LT

        ("down", "chunk") -> GT
        ("down", "startChunk") -> GT
        ("down", "endChunk") -> GT
        ("down", "endAhead") -> GT
        ("down", _) -> LT

        ("downs", "chunk") -> GT
        ("downs", "startChunk") -> GT
        ("downs", "endChunk") -> GT
        ("downs", "endAhead") -> GT
        ("downs", "down") -> GT
        ("downs", _) -> LT

        ("downers", "chunk") -> GT
        ("downers", "startChunk") -> GT
        ("downers", "endChunk") -> GT
        ("downers", "endAhead") -> GT
        ("downers", "down") -> GT
        ("downers", "downs") -> GT
        ("downers", _) -> LT

        ("downward", "chunk") -> GT
        ("downward", "startChunk") -> GT
        ("downward", "endChunk") -> GT
        ("downward", "endAhead") -> GT
        ("downward", "down") -> GT
        ("downward", "downs") -> GT
        ("downward", "downers") -> GT
        ("downward", _) -> LT

        ("rel", "chunk") -> GT
        ("rel", "startChunk") -> GT
        ("rel", "endChunk") -> GT
        ("rel", "endAhead") -> GT
        ("rel", "down") -> GT
        ("rel", "downs") -> GT
        ("rel", "downers") -> GT
        ("rel", "downward") -> GT
        ("rel", _) -> LT

        ("frac", _) -> GT

        ("minDistance", _) -> LT

        ("bestDistance", "minDistance") -> GT
        ("bestDistance", _) -> LT

        ("landout", "minDistance") -> GT
        ("landout", "bestDistance") -> GT
        ("landout", _) -> LT

        ("lookahead", "minDistance") -> GT
        ("lookahead", "bestDistance") -> GT
        ("lookahead", "landout") -> GT
        ("lookahead", _) -> LT

        ("sumOfDifficulty", "minDistance") -> GT
        ("sumOfDifficulty", "bestDistance") -> GT
        ("sumOfDifficulty", "landout") -> GT
        ("sumOfDifficulty", "lookahead") -> GT
        ("sumOfDifficulty", _) -> LT

        ("difficulty", _) -> GT

        _ -> compare a b

 ^ This is a fraction of the possible effort points, not of the
 possible distance points.
 | The landing for a single task.
 ^ The best distance flown.
 ^ The number of pilots landing out.
 ^ How many 100m chunks to look ahead for land outs.
 ^ The chunking.
 ^ The difficulty of each chunk.
 | For each task, the landing for that task.
 ^ For each task, the best distance flown.
 ^ For each task, the number of pilots landing out.
 ^ For each task, the chunking.
 ^ The difficulty of each chunk.
# LANGUAGE DuplicateRecordFields #

| 
 Module       : Flight . Track . Mask 
 Copyright    : ( c ) Block Scope Limited 2017 
 License      : MPL-2.0 
 Maintainer   :  
 Stability    : experimental 

 Tracks masked with task control zones . 

Module      : Flight.Track.Mask
Copyright   : (c) Block Scope Limited 2017
License     : MPL-2.0
Maintainer  : 
Stability   : experimental

Tracks masked with task control zones.
-}
module Flight.Track.Land
    ( TaskLanding(..)
    , CompLanding(..)
    , TrackEffort(..)
    , effortRank
    , mkCompLandOut, unMkCompLandOut, taskLanding
    ) where

import Lens.Micro ((^?), ix)
import Data.List (sortOn, unzip5)
import Data.String (IsString())
import GHC.Generics (Generic)
import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.UnitsOfMeasure (u, convert)
import Data.UnitsOfMeasure.Internal (Quantity(..))

import Flight.Field (FieldOrdering(..))
import Flight.Distance (QTaskDistance, TaskDistance(..))
import "flight-gap-allot" Flight.Score ( Pilot(..), PilotDistance(..), FlownMax(..))
import "flight-gap-effort" Flight.Score
    ( Lookahead
    , Chunking(..)
    , ChunkDifficulty(..)
    , DifficultyFraction(..)
    )
import Flight.Comp (IxTask(..))
import Flight.Track.Curry (uncurry5)

data TrackEffort =
    TrackEffort
        { effort :: QTaskDistance Double [u| m |]
        , frac :: DifficultyFraction
        }
    deriving (Eq, Ord, Show, Generic)
    deriving anyclass (FromJSON, ToJSON)

chunkEffort :: ChunkDifficulty -> [(Pilot, TrackEffort)]
chunkEffort ChunkDifficulty{downs, downers, frac = DifficultyFraction df} =
    [
        ( pilot
        , TrackEffort
            { effort = TaskDistance $ convert d
  NOTE : Make maximum track effort unit , 1 . Difficulty points are
  half of the distance points so we need to double the fraction .
            , frac = DifficultyFraction $ 2 * df
            }
        )
    | PilotDistance d <- downs
    | pilot <- downers
    ]

effortRank :: CompLanding -> [[(Pilot, TrackEffort)]]
effortRank CompLanding{difficulty} =
    [ maybe
        []
        ( sortOn
            ( (\TrackEffort{frac = DifficultyFraction x} -> negate x)
            . snd
            )
        . concatMap chunkEffort
        )
        d
    | d <- difficulty
    ]

data TaskLanding =
    TaskLanding
        { bestDistance :: Maybe (FlownMax (Quantity Double [u| km |]))
        , landout :: Int
        , lookahead :: Maybe Lookahead
        , chunking :: Maybe Chunking
        , difficulty :: Maybe [ChunkDifficulty]
        }
    deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)

data CompLanding =
    CompLanding
        { bestDistance :: [Maybe (FlownMax (Quantity Double [u| km |]))]
        , landout :: [Int]
        , lookahead :: [Maybe Lookahead]
  ^ For each task , how many 100 m chunks to look ahead for land outs .
        , chunking :: [Maybe Chunking]
        , difficulty :: [Maybe [ChunkDifficulty]]
        }
    deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)

mkCompLandOut :: [TaskLanding] -> CompLanding
mkCompLandOut ts =
    uncurry5 CompLanding $ unzip5
    [ (a, b, c, d, e)
    | TaskLanding
        { bestDistance = a
        , landout = b
        , lookahead = c
        , chunking = d
        , difficulty = e
        } <- ts
    ]

unMkCompLandOut :: CompLanding -> [TaskLanding]
unMkCompLandOut
    CompLanding
        { bestDistance = as
        , landout = bs
        , lookahead = cs
        , chunking = ds
        , difficulty = es
        } =
    [ TaskLanding a b c d e
    | a <- as
    | b <- bs
    | c <- cs
    | d <- ds
    | e <- es
    ]

taskLanding :: IxTask -> CompLanding -> Maybe TaskLanding
taskLanding (IxTask iTask) CompLanding{..} = do
    let i = fromIntegral iTask - 1
    bd <- bestDistance ^? ix i
    lo <- landout ^? ix i
    la <- lookahead ^? ix i
    cg <- chunking ^? ix i
    df <- difficulty ^? ix i
    return
        TaskLanding
            { bestDistance = bd
            , landout = lo
            , lookahead = la
            , chunking = cg
            , difficulty = df
            }

instance FieldOrdering TaskLanding where fieldOrder _ = cmp
instance FieldOrdering CompLanding where fieldOrder _ = cmp

cmp :: (Ord a, IsString a) => a -> a -> Ordering
cmp a b =
    case (a, b) of
        ("chunk", _) -> LT

        ("startChunk", "chunk") -> GT
        ("startChunk", _) -> LT

        ("endChunk", "chunk") -> GT
        ("endChunk", "startChunk") -> GT
        ("endChunk", _) -> LT

        ("endAhead", "chunk") -> GT
        ("endAhead", "startChunk") -> GT
        ("endAhead", "endChunk") -> GT
        ("endAhead", _) -> LT

        ("down", "chunk") -> GT
        ("down", "startChunk") -> GT
        ("down", "endChunk") -> GT
        ("down", "endAhead") -> GT
        ("down", _) -> LT

        ("downs", "chunk") -> GT
        ("downs", "startChunk") -> GT
        ("downs", "endChunk") -> GT
        ("downs", "endAhead") -> GT
        ("downs", "down") -> GT
        ("downs", _) -> LT

        ("downers", "chunk") -> GT
        ("downers", "startChunk") -> GT
        ("downers", "endChunk") -> GT
        ("downers", "endAhead") -> GT
        ("downers", "down") -> GT
        ("downers", "downs") -> GT
        ("downers", _) -> LT

        ("downward", "chunk") -> GT
        ("downward", "startChunk") -> GT
        ("downward", "endChunk") -> GT
        ("downward", "endAhead") -> GT
        ("downward", "down") -> GT
        ("downward", "downs") -> GT
        ("downward", "downers") -> GT
        ("downward", _) -> LT

        ("rel", "chunk") -> GT
        ("rel", "startChunk") -> GT
        ("rel", "endChunk") -> GT
        ("rel", "endAhead") -> GT
        ("rel", "down") -> GT
        ("rel", "downs") -> GT
        ("rel", "downers") -> GT
        ("rel", "downward") -> GT
        ("rel", _) -> LT

        ("frac", _) -> GT

        ("minDistance", _) -> LT

        ("bestDistance", "minDistance") -> GT
        ("bestDistance", _) -> LT

        ("landout", "minDistance") -> GT
        ("landout", "bestDistance") -> GT
        ("landout", _) -> LT

        ("lookahead", "minDistance") -> GT
        ("lookahead", "bestDistance") -> GT
        ("lookahead", "landout") -> GT
        ("lookahead", _) -> LT

        ("sumOfDifficulty", "minDistance") -> GT
        ("sumOfDifficulty", "bestDistance") -> GT
        ("sumOfDifficulty", "landout") -> GT
        ("sumOfDifficulty", "lookahead") -> GT
        ("sumOfDifficulty", _) -> LT

        ("difficulty", _) -> GT

        _ -> compare a b
