{-# LANGUAGE OverloadedStrings #-}
-- the following ones are necessary for the generics-sop magic
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators     #-}

module Poseidon.CLI.Survey where

import           Poseidon.BibFile          (BibTeX)
import           Poseidon.ColumnTypesJanno (GeneticSex (..))
import           Poseidon.ColumnTypesUtils (CsvNamedRecord, ListColumn (..))
import           Poseidon.GenotypeData     (GenotypeDataSpec (..),
                                            GenotypeFileSpec (..))
import           Poseidon.Janno            (JannoRows (..))
import           Poseidon.Package          (PackageReadOptions (..),
                                            PoseidonPackage (..),
                                            defaultPackageReadOptions,
                                            readPoseidonPackageCollection)
import           Poseidon.Utils            (PoseidonIO, logInfo)

import           Control.Monad             (forM)
import           Control.Monad.IO.Class    (liftIO)
import           Data.List                 (intercalate, unfoldr, zip5)
import           Data.Ratio                (Ratio, (%))
import           Generics.SOP              (All, Generic (Code, from),
                                            HCollapse (hcollapse),
                                            HPure (hpure), I, K (K), NP,
                                            Proxy (..), SListI, hcmap, hzipWith,
                                            unI, unSOP, unZ)
import           Poseidon.SequencingSource (SeqSourceRows (..))
import           System.Directory          (doesFileExist)
import           System.FilePath           ((</>))
import           Text.Layout.Table         (asciiRoundS, column, def,
                                            expandUntil, rowsG, tableString,
                                            titlesH)

-- | A datatype representing command line options for the survey command
data SurveyOptions = SurveyOptions
    { SurveyOptions -> [[Char]]
_surveyBaseDirs   :: [FilePath]
    , SurveyOptions -> Bool
_surveyRawOutput  :: Bool
    , SurveyOptions -> Bool
_surveyOnlyLatest :: Bool
    }

-- | The main function running the janno command
runSurvey :: SurveyOptions -> PoseidonIO ()
runSurvey :: SurveyOptions -> PoseidonIO ()
runSurvey (SurveyOptions [[Char]]
baseDirs Bool
rawOutput Bool
onlyLatest) = do
    let pacReadOpts :: PackageReadOptions
pacReadOpts = PackageReadOptions
defaultPackageReadOptions {
          _readOptIgnoreChecksums  = True
        , _readOptIgnoreGeno       = True
        , _readOptGenoCheck        = False
        , _readOptOnlyLatest       = onlyLatest
    }
    [PoseidonPackage]
allPackages <- PackageReadOptions -> [[Char]] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
pacReadOpts [[Char]]
baseDirs
    -- collect information
    let packageNames :: [PacNameAndVersion]
packageNames = (PoseidonPackage -> PacNameAndVersion)
-> [PoseidonPackage] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion [PoseidonPackage]
allPackages
    -- geno
    [Bool]
genoTypeDataExists <- [PoseidonPackage]
-> (PoseidonPackage -> ReaderT Env IO Bool)
-> ReaderT Env IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PoseidonPackage]
allPackages ((PoseidonPackage -> ReaderT Env IO Bool) -> ReaderT Env IO [Bool])
-> (PoseidonPackage -> ReaderT Env IO Bool)
-> ReaderT Env IO [Bool]
forall a b. (a -> b) -> a -> b
$ \PoseidonPackage
pac -> do
        case GenotypeDataSpec -> GenotypeFileSpec
genotypeFileSpec (GenotypeDataSpec -> GenotypeFileSpec)
-> (PoseidonPackage -> GenotypeDataSpec)
-> PoseidonPackage
-> GenotypeFileSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonPackage -> GenotypeDataSpec
posPacGenotypeData (PoseidonPackage -> GenotypeFileSpec)
-> PoseidonPackage -> GenotypeFileSpec
forall a b. (a -> b) -> a -> b
$ PoseidonPackage
pac of
            GenotypeEigenstrat [Char]
gf Maybe [Char]
_ [Char]
sf Maybe [Char]
_ [Char]
i Maybe [Char]
_ -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ReaderT Env IO [Bool] -> ReaderT Env IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ReaderT Env IO Bool)
-> [[Char]] -> ReaderT Env IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool)
-> ([Char] -> IO Bool) -> [Char] -> ReaderT Env IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> ([Char] -> [Char]) -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoseidonPackage -> [Char]
posPacBaseDir PoseidonPackage
pac [Char] -> [Char] -> [Char]
</>)) [[Char]
gf, [Char]
sf, [Char]
i]
            GenotypePlink      [Char]
gf Maybe [Char]
_ [Char]
sf Maybe [Char]
_ [Char]
i Maybe [Char]
_ -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ReaderT Env IO [Bool] -> ReaderT Env IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ReaderT Env IO Bool)
-> [[Char]] -> ReaderT Env IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool)
-> ([Char] -> IO Bool) -> [Char] -> ReaderT Env IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> ([Char] -> [Char]) -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoseidonPackage -> [Char]
posPacBaseDir PoseidonPackage
pac [Char] -> [Char] -> [Char]
</>)) [[Char]
gf, [Char]
sf, [Char]
i]
            GenotypeVCF        [Char]
gf Maybe [Char]
_          ->               IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool)
-> ([Char] -> IO Bool) -> [Char] -> ReaderT Env IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Bool
doesFileExist ([Char] -> ReaderT Env IO Bool) -> [Char] -> ReaderT Env IO Bool
forall a b. (a -> b) -> a -> b
$  PoseidonPackage -> [Char]
posPacBaseDir PoseidonPackage
pac [Char] -> [Char] -> [Char]
</>    [Char]
gf
    -- janno
    let jannos :: [JannoRows]
jannos = (PoseidonPackage -> JannoRows) -> [PoseidonPackage] -> [JannoRows]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> JannoRows
posPacJanno [PoseidonPackage]
allPackages
    -- ssf
    let ssfs :: [SeqSourceRows]
ssfs = (PoseidonPackage -> SeqSourceRows)
-> [PoseidonPackage] -> [SeqSourceRows]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> SeqSourceRows
posPacSeqSource [PoseidonPackage]
allPackages
    -- bib
    let bibs :: [BibTeX]
bibs = (PoseidonPackage -> BibTeX) -> [PoseidonPackage] -> [BibTeX]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> BibTeX
posPacBib [PoseidonPackage]
allPackages
    -- print information
    ([[Char]]
tableH, [[[Char]]]
tableB) <- do
        let tableH :: [[Char]]
tableH = [[Char]
"Package", [Char]
"Survey"]
        [[[Char]]]
tableB <- [(PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)]
-> ((PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)
    -> ReaderT Env IO [[Char]])
-> ReaderT Env IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([PacNameAndVersion]
-> [Bool]
-> [JannoRows]
-> [SeqSourceRows]
-> [BibTeX]
-> [(PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 [PacNameAndVersion]
packageNames [Bool]
genoTypeDataExists [JannoRows]
jannos [SeqSourceRows]
ssfs [BibTeX]
bibs) (((PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)
  -> ReaderT Env IO [[Char]])
 -> ReaderT Env IO [[[Char]]])
-> ((PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)
    -> ReaderT Env IO [[Char]])
-> ReaderT Env IO [[[Char]]]
forall a b. (a -> b) -> a -> b
$ \(PacNameAndVersion
p, Bool
g, JannoRows
j, SeqSourceRows
s, BibTeX
b) -> do
            [[Char]] -> ReaderT Env IO [[Char]]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PacNameAndVersion -> [Char]
forall a. Show a => a -> [Char]
show PacNameAndVersion
p, Bool -> JannoRows -> SeqSourceRows -> BibTeX -> [Char]
renderPackageWithCompleteness Bool
g JannoRows
j SeqSourceRows
s BibTeX
b]
        ([[Char]], [[[Char]]]) -> ReaderT Env IO ([[Char]], [[[Char]]])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
tableH, [[[Char]]]
tableB)
    let colSpecs :: [ColSpec]
colSpecs = Int -> ColSpec -> [ColSpec]
forall a. Int -> a -> [a]
replicate Int
2 (LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec
column (Int -> LenSpec
expandUntil Int
60) Position H
forall a. Default a => a
def AlignSpec
forall a. Default a => a
def CutMark
forall a. Default a => a
def)
    if Bool
rawOutput
    then IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" [[Char]]
row | [[Char]]
row <- [[[Char]]]
tableB]
    else IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [ColSpec]
-> TableStyle -> HeaderSpec -> [RowGroup [Char]] -> [Char]
forall a.
Cell a =>
[ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> [Char]
tableString [ColSpec]
colSpecs TableStyle
asciiRoundS ([[Char]] -> HeaderSpec
titlesH [[Char]]
tableH) [[[[Char]]] -> RowGroup [Char]
forall a. [Row a] -> RowGroup a
rowsG [[[Char]]]
tableB]
    -- print help
    [Char] -> PoseidonIO ()
logInfo [Char]
"see trident survey -h for a list of column names"

renderPackageWithCompleteness :: Bool -> JannoRows -> SeqSourceRows -> BibTeX -> String
renderPackageWithCompleteness :: Bool -> JannoRows -> SeqSourceRows -> BibTeX -> [Char]
renderPackageWithCompleteness Bool
genoTypeDataExists JannoRows
janno (SeqSourceRows [SeqSourceRow]
seqSource) BibTeX
bib =
       (if Bool
genoTypeDataExists then [Char]
"G" else [Char]
".")
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not ([SeqSourceRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SeqSourceRow]
seqSource) then [Char]
"S" else [Char]
".")
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not (BibTeX -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null BibTeX
bib) then [Char]
"B" else [Char]
".")
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"|"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char] -> [Char]
forall a. Int -> a -> [a] -> [a]
insertEveryN Int
5 Char
'|' (JannoRows -> [Char]
renderJannoCompleteness JannoRows
janno)
    where
        -- https://stackoverflow.com/questions/12659562/insert-specific-element-y-after-every-n-elements-in-a-list
        insertEveryN :: Int -> a -> [a] -> [a]
        insertEveryN :: forall a. Int -> a -> [a] -> [a]
insertEveryN Int
n a
y [a]
xs = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
intercalate [a
y] ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [[a]]
forall {a}. Int -> [a] -> [[a]]
groups Int
n ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs
            where groups :: Int -> [a] -> [[a]]
groups Int
n_ [a]
xs_ = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> Maybe ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n_) ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a]
xs_

renderJannoCompleteness :: JannoRows -> String
renderJannoCompleteness :: JannoRows -> [Char]
renderJannoCompleteness (JannoRows [JannoRow]
rows) =
    let ratioString :: [Char]
ratioString = (Ratio Int -> Char) -> [Ratio Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Ratio Int -> Char
prop2Char ([Ratio Int] -> [Char]) -> [Ratio Int] -> [Char]
forall a b. (a -> b) -> a -> b
$ [JannoRow] -> [Ratio Int]
forall a (xs :: [*]).
(Generic a, Code a ~ '[xs], All PresenceCountable xs) =>
[a] -> [Ratio Int]
getRatiosForEachField [JannoRow]
rows
    in [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
ratioString -- remove last entry covering the additional columns (CsvNamedRecord)
    where
        -- the following magic was heavily inspired by https://stackoverflow.com/a/41524511/3216883
        getRatiosForEachField :: (Generics.SOP.Generic a, Code a ~ '[ xs ], All PresenceCountable xs) => [a] -> [Ratio Int] --'
        getRatiosForEachField :: forall a (xs :: [*]).
(Generic a, Code a ~ '[xs], All PresenceCountable xs) =>
[a] -> [Ratio Int]
getRatiosForEachField =
            NP (K (Ratio Int)) xs -> [Ratio Int]
NP (K (Ratio Int)) xs -> CollapseTo NP (Ratio Int)
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
          (NP (K (Ratio Int)) xs -> [Ratio Int])
-> ([a] -> NP (K (Ratio Int)) xs) -> [a] -> [Ratio Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy PresenceCountable
-> (forall a. PresenceCountable a => [a] -> K (Ratio Int) a)
-> NP [] xs
-> NP (K (Ratio Int)) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy PresenceCountable
forall {k} (t :: k). Proxy t
Proxy :: Proxy PresenceCountable) (Ratio Int -> K (Ratio Int) a
forall k a (b :: k). a -> K a b
K (Ratio Int -> K (Ratio Int) a)
-> ([a] -> Ratio Int) -> [a] -> K (Ratio Int) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Ratio Int
forall a. PresenceCountable a => [a] -> Ratio Int
measureFillState)
          (NP [] xs -> NP (K (Ratio Int)) xs)
-> ([a] -> NP [] xs) -> [a] -> NP (K (Ratio Int)) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NP I xs] -> NP [] xs
forall (xs :: [*]). SListI xs => [NP I xs] -> NP [] xs
hunzip
          ([NP I xs] -> NP [] xs) -> ([a] -> [NP I xs]) -> [a] -> NP [] xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> NP I xs) -> [a] -> [NP I xs]
forall a b. (a -> b) -> [a] -> [b]
map (NS (NP I) '[xs] -> NP I xs
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS (NP I) '[xs] -> NP I xs)
-> (a -> NS (NP I) '[xs]) -> a -> NP I xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I '[xs] -> NS (NP I) '[xs]
forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP (SOP I '[xs] -> NS (NP I) '[xs])
-> (a -> SOP I '[xs]) -> a -> NS (NP I) '[xs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SOP I '[xs]
a -> Rep a
forall a. Generic a => a -> Rep a
from)
        hunzip :: SListI xs => [NP I xs] -> NP [] xs
        hunzip :: forall (xs :: [*]). SListI xs => [NP I xs] -> NP [] xs
hunzip = (NP I xs -> NP [] xs -> NP [] xs)
-> NP [] xs -> [NP I xs] -> NP [] xs
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall a. I a -> [a] -> [a])
-> Prod NP I xs -> NP [] xs -> NP [] xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hzipWith ((:) (a -> [a] -> [a]) -> (I a -> a) -> I a -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> a
forall a. I a -> a
unI)) ((forall a. [a]) -> NP [] xs
forall (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure [])
        measureFillState :: PresenceCountable a => [a] -> Ratio Int
        measureFillState :: forall a. PresenceCountable a => [a] -> Ratio Int
measureFillState [a]
vals =
            let nrValues :: Int
nrValues = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vals
                nrFilledValues :: Int
nrFilledValues = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. PresenceCountable a => a -> Int
countPresence [a]
vals
            in Int
nrFilledValues Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Int
nrValues
        prop2Char :: Ratio Int -> Char
        prop2Char :: Ratio Int -> Char
prop2Char Ratio Int
r
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Int
0    = Char
'.'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio Int
0.25  = Char
'░'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio Int
0.5   = Char
'▒'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio Int
1     = Char
'▓'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Int
1    = Char
'█'
            | Bool
otherwise = Char
'?'

-- A typeclass to determine if a field in a .janno row is filled
class PresenceCountable a where
    countPresence :: a -> Int
instance PresenceCountable (Maybe a) where
    countPresence :: Maybe a -> Int
countPresence Maybe a
Nothing  = Int
0
    countPresence (Just a
_) = Int
1
instance PresenceCountable String where
    countPresence :: [Char] -> Int
countPresence [Char]
_ = Int
1
instance PresenceCountable GeneticSex where
    countPresence :: GeneticSex -> Int
countPresence GeneticSex
_ = Int
1
instance PresenceCountable (ListColumn a) where
    countPresence :: ListColumn a -> Int
countPresence ListColumn a
_ = Int
1
instance PresenceCountable CsvNamedRecord where
    countPresence :: CsvNamedRecord -> Int
countPresence CsvNamedRecord
_ = Int
0