OnAipRecords.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Aviation.Aip.OnAipRecords(
  OnAipRecords(..)
, ioOnAipRecords
, nothingOnAipRecords
, resultOnAipRecords
, logOnAipRecords
, downloaddirOnAipRecords
, basedirOnAipRecords
, aipRecordsOnAipRecords
, prefixedAipRecordsOnAipRecords
, aipRecordsTimeOnAipRecords
, aipRecordsTimesOnAipRecords
, printOnAipRecords
, OnAipRecordsAipCon
, OnAipRecordsIO
, logeachOnAipRecords
, logShowOnAipRecords
) where

import Control.Category((.))
import Control.Applicative(Applicative(pure, (<*>)), Alternative((<|>), empty))
import Control.Lens hiding ((<.>))
import Control.Monad(Monad(return, (>>=)))
import Control.Monad.IO.Class(MonadIO(liftIO))
import Control.Monad.Trans.Class(MonadTrans(lift))
import Data.Aviation.Aip.AipCon(AipCon)
import Data.Aviation.Aip.AipRecord(aipRecordTime)
import Data.Aviation.Aip.AipRecords(AipRecords, aipRecords1)
import Data.Aviation.Aip.Href(aipPrefix)
import Data.Either(Either(Left, Right), either)
import Data.Foldable(toList)
import Data.Functor(Functor(fmap))
import Data.Functor.Alt(Alt((<!>)))
import Data.Functor.Apply(Apply((<.>)))
import Data.Functor.Bind(Bind((>>-)))
import Data.List.NonEmpty(NonEmpty)
import Data.String(String)
import Data.Time(UTCTime)
import Prelude(Show(show))
import System.FilePath(FilePath)
import System.IO(IO, print, putStrLn)
import Control.Exception(IOException)

newtype OnAipRecords f a =
  OnAipRecords
    (Either IOException (FilePath, AipRecords) -> (String -> IO ()) -> FilePath -> f a)

instance Functor f => Functor (OnAipRecords f) where
  fmap f (OnAipRecords x) =
    OnAipRecords (\h l d -> fmap f (x h l d))

instance Apply f => Apply (OnAipRecords f) where
  OnAipRecords f <.> OnAipRecords a =
    OnAipRecords (\h l d -> f h l d <.> a h l d)

instance Applicative f => Applicative (OnAipRecords f) where
  pure =
    OnAipRecords . pure . pure . pure . pure

  OnAipRecords f <*> OnAipRecords a =
    OnAipRecords (\h l d -> f h l d <*> a h l d)

instance Bind f => Bind (OnAipRecords f) where
  OnAipRecords x >>- f =
    OnAipRecords (\h l d -> x h l d >>- \a -> let g = f a ^. _Wrapped in g h l d)

instance Monad f => Monad (OnAipRecords f) where
  return =
    pure
  OnAipRecords x >>= f =
    OnAipRecords (\h l d -> x h l d >>= \a -> let g = f a ^. _Wrapped in g h l d)

instance Alt f => Alt (OnAipRecords f) where
  OnAipRecords x <!> OnAipRecords y =
    OnAipRecords (\h l d -> x h l d <!> y h l d)

instance Alternative f => Alternative (OnAipRecords f) where
  OnAipRecords x <|> OnAipRecords y =
    OnAipRecords (\h l d -> x h l d <|> y h l d)
  empty =
    (OnAipRecords . pure . pure . pure) empty

instance MonadTrans OnAipRecords where
  lift =
    OnAipRecords . pure . pure . pure

instance MonadIO f => MonadIO (OnAipRecords f) where
  liftIO =
    OnAipRecords . pure . pure . pure . liftIO

instance OnAipRecords f a ~ x =>
  Rewrapped (OnAipRecords g k) x

instance Wrapped (OnAipRecords f k) where
  type Unwrapped (OnAipRecords f k) =
      Either IOException (FilePath, AipRecords)
      -> (String -> IO ())
      -> FilePath
      -> f k
  _Wrapped' =
    iso
      (\(OnAipRecords x) -> x)
      OnAipRecords

ioOnAipRecords ::
  MonadIO f =>
  (Either IOException (FilePath, AipRecords) -> (String -> IO ()) -> FilePath -> IO a)
  -> OnAipRecords f a
ioOnAipRecords k =
  OnAipRecords (\h l d -> liftIO (k h l d))

nothingOnAipRecords ::
  Applicative f =>
  OnAipRecords f ()
nothingOnAipRecords =
  pure ()

resultOnAipRecords ::
  Applicative f =>
  OnAipRecords f (Either IOException (FilePath, AipRecords))
resultOnAipRecords =
  OnAipRecords (\h _ _ -> pure h)

logOnAipRecords ::
  Applicative f =>
  OnAipRecords f (String -> IO ())
logOnAipRecords =
  OnAipRecords (\_ l _ -> pure l)

printOnAipRecords ::
  OnAipRecordsIO ()
printOnAipRecords =
  OnAipRecords (\h _ d ->
    do  case h of
          Left e ->
            print e
          Right (b, r) ->
            do  print r
                putStrLn b
        putStrLn d)

basedirOnAipRecords ::
  Applicative f =>
  OnAipRecords f FilePath
basedirOnAipRecords =
  OnAipRecords (\_ _ d -> pure d)

downloaddirOnAipRecords ::
  Applicative f =>
  OnAipRecords f (Either IOException FilePath)
downloaddirOnAipRecords =
  OnAipRecords (\e _ _ -> pure (fmap (view _1) e))

aipRecordsOnAipRecords ::
  Applicative f =>
  OnAipRecords f (Either IOException AipRecords)
aipRecordsOnAipRecords =
  OnAipRecords (\e _ _ -> pure (fmap (view _2) e))

prefixedAipRecordsOnAipRecords ::
  Applicative f =>
  OnAipRecords f (Either IOException AipRecords)
prefixedAipRecordsOnAipRecords =
  fmap (fmap aipPrefix) aipRecordsOnAipRecords

aipRecordsTimeOnAipRecords ::
  Applicative f =>
  OnAipRecords f (Either IOException (NonEmpty UTCTime))
aipRecordsTimeOnAipRecords =
  fmap (fmap (fmap (view aipRecordTime) . view aipRecords1)) aipRecordsOnAipRecords

aipRecordsTimesOnAipRecords ::
  Applicative f =>
  OnAipRecords f [UTCTime]
aipRecordsTimesOnAipRecords =
  fmap (either (pure []) toList) aipRecordsTimeOnAipRecords

type OnAipRecordsAipCon a =
  OnAipRecords AipCon a

type OnAipRecordsIO a =
  OnAipRecords IO a

logeachOnAipRecords ::
  OnAipRecordsIO ()
logeachOnAipRecords =
  OnAipRecords (\h l d ->
    do  l (either show show h)
        l (show d))

logShowOnAipRecords ::
  Show a =>
  a
  -> OnAipRecordsIO ()
logShowOnAipRecords z =
  do  l <- logOnAipRecords
      lift (l (show z))