{- |
Module                  : DrCabal.Model
Copyright               : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

Data types to model the domain of the @cabal@ output.
-}

module DrCabal.Model
    ( Style (..)
    , Line (..)
    , Status (..)
    , Entry (..)
    , parseLine
    ) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=))

import qualified Data.Text as Text


data Style = Stacked

data Line = Line
    { Line -> Word64
lineTime :: Word64
    , Line -> ByteString
lineLine :: ByteString
    } deriving stock (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

data Status
    = Downloading
    | Downloaded
    | Starting
    | Building
    | Haddock
    | Installing
    | Completed
    deriving stock (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, ReadPrec [Status]
ReadPrec Status
Int -> ReadS Status
ReadS [Status]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Status]
$creadListPrec :: ReadPrec [Status]
readPrec :: ReadPrec Status
$creadPrec :: ReadPrec Status
readList :: ReadS [Status]
$creadList :: ReadS [Status]
readsPrec :: Int -> ReadS Status
$creadsPrec :: Int -> ReadS Status
Read, Status -> Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Eq Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
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
min :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmax :: Status -> Status -> Status
>= :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c< :: Status -> Status -> Bool
compare :: Status -> Status -> Ordering
$ccompare :: Status -> Status -> Ordering
Ord, Int -> Status
Status -> Int
Status -> [Status]
Status -> Status
Status -> Status -> [Status]
Status -> Status -> Status -> [Status]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Status -> Status -> Status -> [Status]
$cenumFromThenTo :: Status -> Status -> Status -> [Status]
enumFromTo :: Status -> Status -> [Status]
$cenumFromTo :: Status -> Status -> [Status]
enumFromThen :: Status -> Status -> [Status]
$cenumFromThen :: Status -> Status -> [Status]
enumFrom :: Status -> [Status]
$cenumFrom :: Status -> [Status]
fromEnum :: Status -> Int
$cfromEnum :: Status -> Int
toEnum :: Int -> Status
$ctoEnum :: Int -> Status
pred :: Status -> Status
$cpred :: Status -> Status
succ :: Status -> Status
$csucc :: Status -> Status
Enum, Status
forall a. a -> a -> Bounded a
maxBound :: Status
$cmaxBound :: Status
minBound :: Status
$cminBound :: Status
Bounded)

instance ToJSON Status where
    toJSON :: Status -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show

instance FromJSON Status where
    parseJSON :: Value -> Parser Status
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Status" forall a b. (a -> b) -> a -> b
$ \(forall a. ToString a => a -> String
toString -> String
t) -> case forall a. Read a => String -> Maybe a
readMaybe String
t of
        Maybe Status
Nothing     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected status: " forall a. Semigroup a => a -> a -> a
<> String
t
        Just Status
status -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
status

data Entry = Entry
    { Entry -> Status
entryStatus  :: Status
    , Entry -> Word64
entryStart   :: Word64
    , Entry -> Text
entryLibrary :: Text
    } deriving stock (Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)

instance ToJSON Entry where
    toJSON :: Entry -> Value
toJSON Entry{Word64
Text
Status
entryLibrary :: Text
entryStart :: Word64
entryStatus :: Status
entryLibrary :: Entry -> Text
entryStart :: Entry -> Word64
entryStatus :: Entry -> Status
..} = [Pair] -> Value
object
        [ Key
"status"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status
entryStatus
        , Key
"startTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64
entryStart
        , Key
"library"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
entryLibrary
        ]

instance FromJSON Entry where
    parseJSON :: Value -> Parser Entry
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Entry" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Status
entryStatus  <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Word64
entryStart   <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"startTime"
        Text
entryLibrary <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"library"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry{Word64
Text
Status
entryLibrary :: Text
entryStart :: Word64
entryStatus :: Status
entryLibrary :: Text
entryStart :: Word64
entryStatus :: Status
..}

parseLine :: Line -> Maybe Entry
parseLine :: Line -> Maybe Entry
parseLine Line{Word64
ByteString
lineLine :: ByteString
lineTime :: Word64
lineLine :: Line -> ByteString
lineTime :: Line -> Word64
..} = do
    let txtLine :: Text
txtLine = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
lineLine
    Text
txtStatus : Text
library : [Text]
_ <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. IsText t "words" => t -> [t]
words Text
txtLine

    -- parse status string to the 'Status' type
    Status
status <- forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString Text
txtStatus

    -- check if this line is a library: '-' separates library name and its version
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Char -> Text -> Bool
Text.elem Char
'-' Text
library

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Entry
        { entryStatus :: Status
entryStatus  = Status
status
        , entryStart :: Word64
entryStart   = Word64
lineTime
        , entryLibrary :: Text
entryLibrary = Text
library
        }